<%@ Language=VBScript %>
<%
Dim strConnString
strConnString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
Server.MapPath("data/SgcDatabase.mdb.mdb") & ";"
strConnString = Application("SQLConnString")
Const DATE_DELIMITER = "'"
' *** End DB Setup ***
Dim cnnFormToDB
Dim strSQL
Dim lngRecsAffected
Dim strTo, strSubject, strBody
Dim objCDOMail
dim txtItem
dim txtLastName
dim txtFirstName
dim txtEmail
dim txtPhone1
dim txtPhone2
dim dteDate
dim txtAddress
dim txtZip
dim txtCity
DIM Items
DIM V
dim s
dim txtMemo
Dim strErrorMsg ' Holds error message if we catch any problems.
set Items = server.CreateObject("Scripting.Dictionary")
Items.Add "", "Blank"
Items.Add "Catalogs", "Catalogs"
Items.Add "Pictures", "Pictures"
Items.Add "Brochures", "Brochures"
Items.Add "Pricing", "Pricing"
' See if we have any info to process.
' If we don't (ie. the first time through) we just show
' the form. If we do we proceed with the insert.
If Request.Form("action") <> "Save Form Data" Then
' Show the form
%>Feedback
<%
Else
' Do our DB insert!
' Retrieve the 3 strings to be entered into the DB
txtItem= Request.Form("newItem")
txtLastName= Request.Form("Last_Name")
txtFirstName= Request.Form("First_Name")
txtEmail= Request.Form("Email")
txtPhone1= Request.Form("Primary_Phone")
txtPhone2= Request.Form("Secondary_Phone")
txtAddress=Request.Form("Address")
txtcity = Request.Form("City")
txtZip = Request.Form("Zip")
dteDate = now()
txtMemo= Request.Form("message")
' Start error handling... I'm too lazy to check all the criteria
' on my own so I use VBScript to do it for me. I simply do a
' conversion the the expected type and if it fails I catch the
' error, abort the insert, and display a message.
On Error Resume Next
strErrorMsg = ""
' Item (1)
txtItem = Trim(txtItem)
' If Len(txtItem) = 0 Or Len(txtItem) > 10 Then Err.Raise 1
' txtItem = Replace(txtItem, "'", "''")
' If Err.number <> 0 Then
' strErrorMsg = strErrorMsg & "Your entry for color is " & _
' "inappropriate! " & vbCrLf
' Err.Clear
' End If
'Last name (3)
txtLastName = Trim(txtLastName)
If Len(txtLastName) = 0 Or Len(txtLastName) > 50 Then Err.Raise 1
txtLastName = Replace(txtLastName, "'", "''")
If Err.number <> 0 Then
strErrorMsg = strErrorMsg & "Your entry for last name is " & _
"inappropriate! " & vbCrLf
Err.Clear
End If
'First Name (4)
txtFirstName = Trim(txtFirstName)
If Len(txtFirstName) = 0 Or Len(txtFirstName) > 50 Then Err.Raise 1
txtFirstName = Replace(txtFirstName, "'", "''")
If Err.number <> 0 Then
strErrorMsg = strErrorMsg & "Your entry for first name is " & _
"inappropriate! " & vbCrLf
Err.Clear
End If
'Emial (5)
txtEmail = Trim(txtEmail)
if IsValidEmail(txtEmail) then
If Len(txtEmail) = 0 Or Len(txtEmail) > 50 Then Err.Raise 1
txtEmail = Replace(txtEmail, "'", "''")
If Err.number <> 0 Then
strErrorMsg = strErrorMsg & "Your entry for Email is " & _
"inappropriate! " & vbCrLf
Err.Clear
End If
else
strErrorMsg = strErrorMsg & "Your entry for Email is " & _
"inappropriate! " & vbCrLf
Err.Clear
end if
'Primary Phone (6)
' txtPhone1 = Trim(txtPhone1)
' If Len(txtPhone1) = 0 Or Len(txtPhone1) > 20 Then Err.Raise 1
' txtPhone1 = Replace(txtPhone1, "'", "''")
' If Err.number <> 0 Then
' strErrorMsg = strErrorMsg & "Your entry for Pri-Phone is " & _
' "inappropriate! " & vbCrLf
' Err.Clear
' End If
'Secondary Phone (7)
' txtPhone2 = Trim(txtPhone2)
' If Len(txtPhone2) = 0 Or Len(txtPhone2) > 20 Then Err.Raise 1
' txtPhone2 = Replace(txtPhone2, "'", "''")
' If Err.number <> 0 Then
' strErrorMsg = strErrorMsg & "Your entry for Sec-Phone is " & _
' "inappropriate! " & vbCrLf
' Err.Clear
' End If
' Address (10)
' txtAddress = Trim(txtAddress)
' If Len(txtAddress) = 0 Or Len(txtAddress) > 20 Then Err.Raise 1
' txtAddress = Replace(txtAddress, "'", "''")
' If Err.number <> 0 Then
' strErrorMsg = strErrorMsg & "Your entry for txtAddress is " & _
' "inappropriate! " & vbCrLf
' Err.Clear
' End If
' City (11)
' txtCity = Trim(txtCity)
' If Len(txtCity) = 0 Or Len(txtCity) > 20 Then Err.Raise 1
' txtCity = Replace(txtCity, "'", "''")
' If Err.number <> 0 Then
' strErrorMsg = strErrorMsg & "Your entry for txtCity is " & _
' "inappropriate! " & vbCrLf
' Err.Clear
' End If
' City (12)
' txtZip = Trim(txtZip)
' If Len(txtZip) = 0 Or Len(txtZip) > 20 Then Err.Raise 1
' txtZip = Replace(txtZip, "'", "''")
' If Err.number <> 0 Then
' strErrorMsg = strErrorMsg & "Your entry for txtZip is " & _
' "inappropriate! " & vbCrLf
' Err.Clear
' End If
' Date (13)
datDateTimeField = CDate(datDateTimeField)
If Err.number <> 0 Then
strErrorMsg = strErrorMsg & "Your date could " & _
"not be converted to an date variable! " & vbCrLf
Err.Clear
End If
Function IsValidEmail(strEmail)
Dim bIsValid
bIsValid = True
If Len(strEmail) < 5 Then
bIsValid = False
Else
If Instr(1, strEmail, " ") <> 0 Then
bIsValid = False
Else
If InStr(1, strEmail, "@", 1) < 2 Then
bIsValid = False
Else
If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then
bIsValid = False
End If
End If
End If
End If
IsValidEmail = bIsValid
End Function
' Turns error trapping back off!
On Error Goto 0
' If we have an error in our error string then we show
' the error message o/w we proceed with the insert.
If strErrorMsg <> "" Then
' Show the error message that got us here!
Response.Write strErrorMsg
Else
' Open connection to the DB
Set cnnFormToDB = Server.CreateObject("ADODB.Connection")
cnnFormToDB.Open "DBQ=" & server.MapPath("data/SgcDatabase.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=25;MaxBufferSize=8192;Threads=20;", "username", "password"
' Build our SQL String
strSQL = ""
strSQL = strSQL & "INSERT INTO tblFeedback "
strSQL = strSQL & "(txtLastName, txtFirstName, txtEmial, txtPhone1, txtPhone2, txtAddress, txtCity, txtZip, dteDate, memMessage) " & vbCrLf
strSQL = strSQL & "VALUES ("
strSQL = strSQL & "'" & txtLastName & "'" '(3)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtFirstName & "'" '(4)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtEmail & "'" '(5)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtPhone1 & "'" '(6)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtPhone2 & "'" '(7)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtAddress & "'" '(10)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtCity & "'" '(11)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtZip & "'" '(12)
strSQL = strSQL & ", "
strSQL = strSQL & DATE_DELIMITER & dteDate & DATE_DELIMITER '(13)
strSQL = strSQL & ", "
strSQL = strSQL & "'" & txtMemo & "'" '(11)
strSQL = strSQL & ");"
' Execute the SQL command. I pass it a variable lngRecsAffected
' in which to return the number of records affected. I also tell
' it that this is a text command and it won't be returing any
' records... this helps it execute the script faster!
' And before you ask... I don't know, but YES IT IS OR!!!
cnnFormToDB.Execute strSQL, lngRecsAffected, adCmdText Or adExecuteNoRecords
' Dispose of the CONN object
cnnFormToDB.Close
Set cnnFormToDB = Nothing
' Display a verification message and we're done!
%>
<%
strTo = Request.Form("Email")
strSubject = Request.Form("subject")
strBody = Request.Form("body")
strSubject = "Feedback"
strBody = "THANKS FOR YOUR E-MAIL! " & Vbcrlf & Vbcrlf & Vbcrlf
strBody = strBody & "Name: " & txtLastName & ", " & txtFirstName & Vbcrlf
strBody = strBody & "Date: " & now()
strBody = strBody & vbCrLf & vbCrLf
strBody = strBody & "This was sent to: " & txtEmail
'strBody = strBody & Request.Form("Emial")
strBody = strBody & vbCrLf
Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
objCDOMail.From = "info@supremegear.com"
objCDOMail.To = strTo
objCDOMail.Subject = strSubject
objCDOMail.Body = strBody
objCDOMail.Cc = "info@supremegear.com"
objCDOMail.Bcc = "rguay@supremegear.com"
objCDOMail.Importance = 2
objCDOMail.Send
Set objCDOMail = Nothing
%>
Thanks for your Email!
Message automessage sent to: <%=" " & strTo & "!"%>