%@ Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<%
' ****************************************************
' Change the value of the variable below to the pathname
' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
Dim uploadsDirVar
uploadsDirVar = "D:\WebIIS_HardiggInAction"
' ****************************************************
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(uploadsDirVar) then
TestEnvironment = "Folder " & uploadsDirVar & " does not exist. The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "Folder " & uploadsDirVar & " does not have write permissions. The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
Err.Clear
testFile.Close
fso.DeleteFile(fileName)
If Err.Number<>0 then
TestEnvironment = "Folder " & uploadsDirVar & " does not have delete permissions, although it does have write permissions. Change the permissions for IUSR_computername on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB.Stream")
If Err.Number<>0 then
TestEnvironment = "The ADODB object Stream is not available in your server. Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function
function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "Files uploaded: "
for each fileKey in Upload.UploadedFiles.keys
Photo = Upload.UploadedFiles(fileKey).FileName
SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
'Added Cold
Dim ErrorFound, FirstName, LastName, City, State, Story, NextID, PictureName, Photo, EmailAddress
ErrorFound = 0
'Save Information, Validate Fields
'FirstName, LastName, EmailAddress, City, State, Story, Photo, EmailAddress
FirstName = Upload.Form("FirstName")
LastName = Upload.Form("LastName")
City = Upload.Form("City")
State = Upload.Form("State")
EmailAddress = Upload.Form("EmailAddress")
Story = Upload.Form("Story")
FirstName = Replace(FirstName, "'", "-")
LastName = Replace(LastName, "'", "-")
City = Replace(City, "'", "-")
State = Replace(State, "'", "-")
Story = Replace(Story, "'", "-")
Story = Left(Story, 2000)
If Len(FirstName) = 0 Then
ErrorFound = 1
End IF
If Len(LastName) = 0 Then
ErrorFound = 2
End IF
If Len(City) = 0 Then
ErrorFound = 3
End IF
If Len(State) = 0 Then
ErrorFound = 4
End IF
If Len(Story) = 0 Then
ErrorFound = 5
End IF
If Len(Photo) = 0 Then
ErrorFound = 6
End IF
Dim cn, cnString, rstID, sql, rstINSERT
set cn = server.CreateObject("ADODB.connection")
cnString = "DSN=InternetSalesWeb;UID=SalesWeb;PWD=c^9Y1+xX2q;"
cn.Open cnString
'Get Next ID
Set rstID = server.CreateObject("ADODB.recordset")
sql = "SELECT MAX(IDCounter) AS NextID FROM web_HardiggInAction"
rstID.Open sql, cn
NextID = rstID("NextID") + 1
'Rename Picture
'----------------------------
'PictureName
PictureName = Photo
'----------------------------
'INSERT Record
Set rstINSERT = server.CreateObject("ADODB.recordset")
sql = "INSERT INTO web_HardiggInAction (IDCounter, FirstName, LastName, EmailAddress, City, State, Story, PictureName) " & _
"SELECT '"& NextID &"', '"& FirstName &"', '"& LastName &"', '"& EmailAddress &"', '"& City &"', '"& State &"', '"& Story &"', '"& PictureName &"'"
rstINSERT.Open sql, cn
'Email Notification
Dim TextFileBODY
TextFileBODY = "The Hardigg In Action Form Has Been Filed out on " & Date & "." & vbCrLf
TextFileBODY = TextFileBODY & vbCrLf
TextFileBODY = TextFileBODY & "FirstName: "& vbCrLf
TextFileBODY = TextFileBODY & FirstName & vbCrLf
TextFileBODY = TextFileBODY & "LastName: "& vbCrLf
TextFileBODY = TextFileBODY & LastName & vbCrLf
TextFileBODY = TextFileBODY & "EmailAddress: "& vbCrLf
TextFileBODY = TextFileBODY & EmailAddress & vbCrLf
TextFileBODY = TextFileBODY & "City: "& vbCrLf
TextFileBODY = TextFileBODY & City & vbCrLf
TextFileBODY = TextFileBODY & "State: "& vbCrLf
TextFileBODY = TextFileBODY & State & vbCrLf
TextFileBODY = TextFileBODY & "Story: "& vbCrLf
TextFileBODY = TextFileBODY & Story & vbCrLf
TextFileBODY = TextFileBODY & "PictureName: "& vbCrLf
TextFileBODY = TextFileBODY & PictureName & vbCrLf
Dim objCDOSYSCon, objCDOSYSMail
Set objCDOSYSMail = Server.CreateObject("CDO.Message")
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration")
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail1.hardigg.com"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objCDOSYSCon.Fields.Update
'Update the CDOSYS Configuration
Set objCDOSYSMail.Configuration = objCDOSYSCon
objCDOSYSMail.From = "hardiggweb@hardigg.com"
objCDOSYSMail.To = "andrew@hardigg.com"
objCDOSYSMail.Subject = "Hardigg In Action Form - Filled out"
objCDOSYSMail.TextBody = TextFileBODY
objCDOSYSMail.Send
Set objCDOSYSMail = Nothing
end function
%>
Hardigg Cases - Hardigg In Action Stories - Combat Zone Ready
"Here's the order: we had to get 15 boxes of medications (fragile, water and temperature sensitive, etc) to the top of the world. The first-ever medical clinic on Mount Everest needed equipment. Sturdy, rugged, yak proof? Hardigg fit the bill and sent us 3 medical cabinets that are not only durable for travel but double as our formulary cabinet once we're set up in our medical tent. We're just concluding our second season of use and couldn't be happier. Thanks, Hardigg! "
Hardigg Cases Manufacturer, Distributor, and Supplier of Rugged Plastic Containers
147 North Main Street South Deerfield, MA 01373-0201 USA
ISO 9001:2000 Certified