Helter Skeletons Limited

<% '============================================================ ' Contact form and Captcha by Bob and Aly at AlyDesigns. '============================================================ ' ROUTINES: ' - Function CreateCAPTCHA() ' - Sub InitArrays() ' - Sub CreateStyleSheet() ' - Sub CreateJavascript() ' - Function RandomizeArrayUnique(arr, arrNew) ' - Function RandomizeArray(arr, arrNew) ' - Function RandomNumber(iMax) ' - Function RandomString(iMax) '============================================================ 'Option Explicit On Error Resume Next Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" Response.Expires = -1 '// YOUR PREFERENCES Const MAX_NUMBER_OF_CHARACTERS = 3 '// How many characters in our CAPTCHA? Const MAX_LENGTH_CSS_CLASSES = 12 '// How many characters in the CSS class names? Const CAPTCHA_CHARACTER_FACTOR = 40 '// How many pixels are we moving each new character from left? Const CAPTCHA_BOX_BORDER = "border: 2px solid #ccc;" '// Style the div box holding the CAPTCHA. Const CAPTCHA_BOX_WIDTH = 160 '// Width. This value should balance the number of characters and size. Const CAPTCHA_BOX_HEIGHT = 80 '// Same as above. Const NAME_OF_CAPTCHA_TEXTBOX = "CaptchaBox" '// Name of CAPTCHA text box. Rename this!! 'Declaring Variables Dim smtpserver,youremail,yourpassword,To_email,ContactUs_Name,ContactUs_Email Dim ContactUs_Subject,ContactUs_Body,Action,IsError ' Edit these 3 values accordingly smtpserver = "mail.checkit.ws" youremail = "mailform@checkit.ws" yourpassword = "grant" To_email = "sales@helterskeletons.com" ' Grabbing variables from the form post ContactUs_Name = Request("ContactUs_Name") ContactUs_Email = Request("ContactUs_Email") ContactUs_Subject = Request("ContactUs_Subject") ContactUs_Body = Request("ContactUs_Body") Action = Request("Action") Dim m_arrCaptcha() '// Array holding our CAPTCHA charaters. Hold in session variable. Dim m_arrCaptchaScreen() '// Parallell array where some items migth be hex/decimal encoded for display on screen. Dim m_sCSS '// Our CSS Dim m_sJavascript '// Our Javascript Dim m_sUserResult '// Return a response to client/demo if success or failure Dim m_sNameOfWrapperDiv '// Holding the id name attribute for the div wrapping the CAPTCHA? Dim m_arrColor(4) '// Array of colors for the characters Dim m_arrColorNew(4) '// Same colors randomized Dim m_arrFontFamily(4) '// Array of font family strings Dim m_arrFontFamilyNew(4) '// Same fonts randomized Dim m_arrFontSize(4) '// Array of font sizes Dim m_arrFontSizeNew(4) '// Same font sizes now randomized Dim m_arrTopPosition(4) '// Array of top position values Dim m_arrTopPositionNew(4) '// Same values randomized Dim m_arrClassNames() '// Array of names for the CSS classes Dim m_arrQuestions(3) '// Array of questions for the human visitor Dim m_lngQuestionIndex '// This number between 0 - 3 defines what question to ask the human visitor Dim m_arrCaptchaColor(2) '// Array holding the color of the character we are asking the visitor for Dim m_arrCSSStrings(4) '// Array holding our CSS elements/strings Dim m_arrCSSStringsNew(4) '// Same strings now randomly and uniquely sorted '// START UP THE MODULE ARRAYS m_arrColor(0) = "green" m_arrColor(1) = "blue" m_arrColor(2) = "red" m_arrColor(3) = "black" m_arrColor(4) = "yellow" m_arrFontFamily(0) = "Verdana" m_arrFontFamily(1) = "Arial" m_arrFontFamily(2) = "Tahoma" m_arrFontFamily(3) = "Courier" m_arrFontFamily(4) = "Georgia" m_arrFontSize(0) = 24 m_arrFontSize(1) = 50 m_arrFontSize(2) = 60 m_arrFontSize(3) = 40 m_arrFontSize(4) = 70 m_arrTopPosition(0) = 5 m_arrTopPosition(1) = 10 m_arrTopPosition(2) = 15 m_arrTopPosition(3) = 5 m_arrTopPosition(4) = 10 m_arrQuestions(0) = "Before submitting this form, please type the characters displayed above:" m_arrQuestions(1) = "Before submitting this form, please type the color of the first character:" m_arrQuestions(2) = "Before submitting this form, please type the color of the second character:" m_arrQuestions(3) = "Before submitting this form, please type the color of the third character:" m_arrCSSStrings(0) = "position: absolute;" m_arrCSSStrings(1) = "top: " m_arrCSSStrings(2) = "left: " m_arrCSSStrings(3) = "color: " m_arrCSSStrings(4) = "font: bold " '---------------------------------------------------------------------------------------- ' Used to check that the email entered is in a valid format Function IsValidEmail(Email) Dim ValidFlag,BadFlag,atCount,atLoop,SpecialFlag,UserName,DomainName,atChr,tAry1 ValidFlag = False If (Email <> "") And (InStr(1, Email, "@") > 0) And (InStr(1, Email, ".") > 0) Then atCount = 0 SpecialFlag = False For atLoop = 1 To Len(Email) atChr = Mid(Email, atLoop, 1) If atChr = "@" Then atCount = atCount + 1 If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True Next If (atCount = 1) And (SpecialFlag = False) Then BadFlag = False tAry1 = Split(Email, "@") UserName = tAry1(0) DomainName = tAry1(1) If (UserName = "") Or (DomainName = "") Then BadFlag = True If Mid(DomainName, 1, 1) = "." then BadFlag = True If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True ValidFlag = True End If End If If BadFlag = True Then ValidFlag = False IsValidEmail = ValidFlag End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Call this function from where you want to include the CAPTCHA. '------------------------------------------------------------------------------------------------------------ Function CreateCAPTCHA() On Error Resume Next Dim i, iTmp, sTmp '---------------------------- Create our CAPTCHA! '// This holds plain text characters. They are stored in a session variable and compared with the user input. ReDim m_arrCaptcha(MAX_NUMBER_OF_CHARACTERS - 1) '// This holds the decimal and hexified characters displayed on screen. ReDim m_arrCaptchaScreen(MAX_NUMBER_OF_CHARACTERS - 1) For i = 0 To (MAX_NUMBER_OF_CHARACTERS - 1) sTmp = UCase(RandomString(1)) iTmp = RandomNumber(101) m_arrCaptcha(i) = sTmp If iTmp < 33 Then m_arrCaptchaScreen(i) = "&#" & Asc(UCase(sTmp)) & ";" '// Decimal If iTmp > 66 Then m_arrCaptchaScreen(i) = "&#x" & Hex(Asc(UCase(sTmp))) & ";" '// Hexify If iTmp < 67 And iTmp > 32 Then m_arrCaptchaScreen(i) = UCase(sTmp) '// Plain Ascii Next '---------------------------- What question will we ask the human visitor? m_lngQuestionIndex = RandomNumber(MAX_NUMBER_OF_CHARACTERS + 1) '// Default max number of questions is 4 If m_lngQuestionIndex > 4 Then m_lngQuestionIndex = RandomNumber(4) '---------------------------- Create CSS and javascript Call CreateStyleSheet Call CreateJavascript '---------------------------- Check to see if someone submitted CAPTCHA, machine or human '// You may want to move this code to another part of your own application and do the testing there. ---- MOVED '// Nothing was submitted, so just set a new session value which is our CAPTCHA characters or a color Session("CAPTCHA") = Replace(Join(m_arrCaptcha), " ", "") '// We will ask visitor for a color! Reduce m_lngQuestionIndex by 1 to match the m_arrCaptchaColor array If (m_lngQuestionIndex > 0) Then Session("CAPTCHA") = m_arrCaptchaColor(m_lngQuestionIndex - 1) '---------------------------- Return the html CreateCAPTCHA = m_sCSS & m_sJavascript End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Randomize our module arrays holding the CSS values. '------------------------------------------------------------------------------------------------------------ Sub InitArrays() On Error Resume Next '// First 4 arrays are randomly sorted meaning that all characters might have the same color. Call RandomizeArray(m_arrColor, m_arrColorNew) Call RandomizeArray(m_arrFontFamily, m_arrFontFamilyNew) Call RandomizeArray(m_arrFontSize, m_arrFontSizeNew) Call RandomizeArray(m_arrTopPosition, m_arrTopPositionNew) Call RandomizeArrayUnique(m_arrCSSStrings, m_arrCSSStringsNew) End Sub '------------------------------------------------------------------------------------------------------------ ' Comment: Build the CSS. '------------------------------------------------------------------------------------------------------------ Sub CreateStyleSheet() On Error Resume Next Dim sCSS, i, l, iLeft, sTmp, sTmpClassName '---------------------------- Create the CSS for the div box '// First create a random name for the wrapper div. m_sNameOfWrapperDiv = RandomString(MAX_LENGTH_CSS_CLASSES) sCSS = "" End Sub '------------------------------------------------------------------------------------------------------------ ' Comment: Create the javascript with our unique css class names and the CAPTCHA characters. '------------------------------------------------------------------------------------------------------------ Sub CreateJavascript() On Error Resume Next Dim i, sJScript sJScript = "" & vbCrLf sJScript = sJScript & "

" & m_arrQuestions(m_lngQuestionIndex) & "

" & vbCrLf m_sJavascript = sJScript End Sub '------------------------------------------------------------------------------------------------------------ ' Comment: Randomize array but make sure all values are present in the new array. '------------------------------------------------------------------------------------------------------------ Function RandomizeArrayUnique(arr, arrNew) On Error Resume Next Dim i, l, sBuf, sTmp, iMax iMax = UBound(arr) ReDim arrNew(iMax) For i = 0 To iMax '// This should be enough looping For l = 1 To (iMax * 20) sTmp = arr(RandomNumber(iMax + 1)) If InStr(sBuf, sTmp) = 0 Then sBuf = (sBuf & sTmp) arrNew(i) = sTmp Exit For End If Next Next End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Randomize our module arrays holding the CSS. One value might appear several times. '------------------------------------------------------------------------------------------------------------ Function RandomizeArray(arr, arrNew) On Error Resume Next Dim i ReDim arrNew(UBound(arr)) For i = LBound(arr) To UBound(arr) arrNew(i) = arr(RandomNumber(UBound(arr) + 1)) Next End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Return a random number not bigger than the input parameter. '------------------------------------------------------------------------------------------------------------ Function RandomNumber(iMax) On Error Resume Next Randomize RandomNumber = Int(iMax * Rnd) End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Create a random string of lower case letters [a-z] for the css class names. '------------------------------------------------------------------------------------------------------------ Function RandomString(iMax) On Error Resume Next Dim i, sTmp For i = 1 To iMax sTmp = sTmp & Chr(97 + RandomNumber(26)) '// Return a random number between 97 and 122, ascii values for [a-z] Next RandomString = sTmp End Function '============================================================ END OF ASP CODE %> Helter Skeletons Limited - Contact

<% If Action = "SendEmail" Then ' Here we quickly check/validate the information entered ' These checks could easily be improved to look for more things If IsValidEmail(ContactUs_Email) = "False" Then IsError = "Yes" Response.Write("You did not enter a valid email address.
") End If If ContactUs_Name = "" Then IsError = "Yes" Response.Write("You did not enter a Name.
") End If ' Commented out because Message not required ' If ContactUs_Body = "" Then ' IsError = "Yes" ' Response.Write("You did not enter a Body.
") ' End If If Len(Request.Form(NAME_OF_CAPTCHA_TEXTBOX)) > 0 Then If UCase(Request.Form(NAME_OF_CAPTCHA_TEXTBOX)) = UCase(Session("CAPTCHA")) Then m_sUserResult = "You typed " & Request.Form(NAME_OF_CAPTCHA_TEXTBOX) & " which was correct!" Else IsError = "Yes" m_sUserResult = "You typed " & Request.Form(NAME_OF_CAPTCHA_TEXTBOX) & " which was wrong." & _ "
(Support for cookies must be enabled in your web browser.)" End If Else ' no captcha entered IsError = "Yes" m_sUserResult = "You didn't answer the Captcha question, try again. (Thanks, it helps us screen out spam messages.)" & _ "
(Support for cookies must be enabled in your web browser.)" End If End If ' If there were no input errors and the action of the form is "SendEMail" we send the email off If Action = "SendEmail" And IsError <> "Yes" Then Dim strBody ' Here we create a nice looking html body for the email strBody = strBody & "Contact Us Form submitted at " & Now() & vbCrLf & "

" strBody = strBody & "From http://" & Request.ServerVariables("HTTP_HOST") & vbCrLf & "
" strBody = strBody & "IP " & Request.ServerVariables("REMOTE_ADDR") & vbCrLf & "
" strBody = strBody & "Name" & " : " & " " & Replace(ContactUs_Name,vbCr,"
") & "
" strBody = strBody & "Email" & " : " & " " & Replace(ContactUs_Email,vbCr,"
") & "
" strBody = strBody & "Subject" & " : " & " " & Replace(ContactUs_Subject,vbCr,"
") & "
" strBody = strBody & "
" & Replace(ContactUs_Body,vbCr,"
") & "
" strBody = strBody & "" Dim ObjSendMail Set ObjSendMail = CreateObject("CDO.Message") 'This section provides the configuration information for the remote SMTP server. ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network). ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False) ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = youremail ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = yourpassword ObjSendMail.Configuration.Fields.Update 'End remote SMTP server configuration section== ObjSendMail.To = To_email ObjSendMail.Subject = ContactUs_Subject ObjSendMail.From = ContactUs_Email ' we are sending a html email.. simply switch the comments around to send a text email instead ObjSendMail.HTMLBody = strBody 'ObjSendMail.TextBody = strBody ObjSendMail.Send Set ObjSendMail = Nothing ' change the success messages below to say or do whatever you like ' you could do a response.redirect or offer a hyperlink somewhere.. etc etc %> <% =Replace(ContactUs_Name,vbCr,"") %>,

Thank You For Contacting Helter Skeletons Ltd! Your message, as seen below, has been sent
and we will get back to you as soon as possible.

Message Sent: <% =Replace(ContactUs_Body,vbCr,"
") %> <% Else %> <% End If %>