<% '==================================================== ' = ' Forms To Go 3.2.5 = ' http://www.bebosoft.com/ = ' = '==================================================== CONST kOptional = true CONST kMandatory = false CONST kStringRangeFrom = 1 CONST kStringRangeTo = 2 CONST kStringRangeBetween = 3 CONST kYes = "yes" CONST kNo = "no" '==================================================== ' Function: FilterControlChars = '==================================================== Function FilterCchar(TextToFilter) Dim regEx Set regEx = New RegExp regEx.Global = true regEx.IgnoreCase = true regEx.Pattern ="[\x00-\x1F]" filterCchar = regEx.Replace(TextToFilter, "") End Function '==================================================== ' Function: SQLQuoteReplace = '==================================================== Function SQLQuoteReplace(FieldValue) SQLQuoteReplace = Replace(FieldValue, "'", "''") End Function '==================================================== ' Function: ValidateString = '==================================================== Function check_string(field, low, high, mode, LimitAlpha, LimitNumbers, LimitEmptySpaces, LimitExtraChars, isOpt) check_string = false If LimitAlpha = kYes Then MyRegEx = "A-Za-z" End If If LimitNumbers = kYes Then MyRegEx = MyRegEx & "0-9" End If If LimitEmptySpaces = kYes Then MyRegEx = MyRegEx & " " End If If Len(LimitExtraChars) > 0 Then SpecialChars = "\,[,],-,$,.,*,(,),+,?,^,{,},|" SpecialCharsArray = Split(SpecialChars, ",") For cnt = 0 To UBound(SpecialCharsArray) LimitExtraChars = Replace(LimitExtraChars, SpecialCharsArray(cnt), "\" & SpecialCharsArray(cnt)) Next MyRegEx = MyRegEx & LimitExtraChars End If Set regEx = New RegExp regEx.Pattern = "[^" & MyRegEx & "]" regEx.IgnoreCase = true If ( Len(field) > 0 ) And ( Len(MyRegEx) > 0 ) Then retVal = regEx.Test(field) If retVal Then Exit Function End If End If If ( (Len(field) = 0) and (isOpt = kOptional) ) Then check_string = true Else If (mode = kStringRangeFrom) then If Len(field) >= low then check_string = true End If End If If (mode = kStringRangeTo) then If Len(field) <= high then check_string = true End If End If If (mode = kStringRangeBetween) then If Len(field) >= low and Len(field) <= high then check_string = true End If End If End If End Function '==================================================== ' Function: ValidateEmail = '==================================================== Function check_email(Email, isOpt) Dim regEx, retVal check_email = false If ( (Len(Email) = 0) and (isOpt = kOptional) ) Then check_email = true Else Set regEx = New RegExp regEx.Pattern ="^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,4})$" regEx.IgnoreCase = true retVal = regEx.Test(Email) If retVal Then check_email = true End If End If End Function '==================================================== ' Function: ShowDate = '==================================================== Function ShowDate(ftgdf) Dim FTGNow, FTGDay, FTGMonth, FTGYearS, FTGYearL, FTGHour, FTGMinute, FTGSecond, AMPM FTGNow = Now FTGDay = CStr(Day(FTGNow)) FTGMonth = CStr(Month(FTGNow)) FTGYearS = Right(CStr(Year(FTGNow)), 2) FTGYearL = CStr(Year(FTGNow)) FTGHour = CStr(Hour(FTGNow)) FTGMinute = CStr(Minute(FTGNow)) FTGSecond = CStr(Second(FTGNow)) If FTGDay < 10 Then FTGDay = "0" & FTGDay If FTGMonth < 10 Then FTGMonth = "0" & FTGMonth If FTGHour < 10 Then FTGHour = "0" & FTGHour If FTGMinute < 10 Then FTGMinute = "0" & FTGMinute If FTGSecond < 10 Then FTGSecond = "0" & FTGSecond If ftgdf = 1 Then ShowDate = FTGMonth & "/" & FTGDay & "/" & FTGYearS If ftgdf = 2 Then ShowDate = FTGDay & "/" & FTGMonth & "/" & FTGYearS If ftgdf = 3 Then ShowDate = FTGDay & "/" & FTGMonth & "/" & FTGYearL If ftgdf = 4 Then ShowDate = FTGYearL & "-" & FTGMonth & "-" & FTGDay If ftgdf = 6 Then ShowDate = FTGHour & ":" & FTGMinute & ":" & FTGSecond If ftgdf = 7 Then ShowDate = FTGYearL & "-" & FTGMonth & "-" & FTGDay & " " & FTGHour & ":" & FTGMinute & ":" & FTGSecond If ftgdf = 5 Then AMPM = "AM" FTGHour = Hour(FTGNow) If FTGHour > 12 Then FTGHour = FTGHour - 12 AMPM = "PM" If FTGHour < 10 Then FTGHour = "0" & FTGHour ElseIf FTGHour = 12 Then AMPM = "PM" ElseIf FTGHour < 10 Then FTGHour = "0" & FTGHour End If ShowDate = FTGHour & ":" & FTGMinute & ":" & FTGSecond & " " & AMPM End If End Function Dim ClientIP if Request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" then ClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") else ClientIP = Request.ServerVariables("REMOTE_ADDR") end if Dim aspEMail Set aspEMail = Server.CreateObject("Persits.MailSender") FTGEnquiries = request.form("Enquiries") FTGFirst_Name = request.form("First_Name") FTGLast_Name = request.form("Last_Name") FTGEmail = request.form("Email") FTGContact_Number = request.form("Contact_Number") FTGCompany = request.form("Company") FTGAddress = request.form("Address") FTGSubject = request.form("Subject") FTGQuestions = request.form("Questions") FTGSubscibe = request.form("Subscibe") FTGSubmit = request.form("Submit") FTGSubmit2 = request.form("Submit2") ' Fields Validations validationFailed = false If (not check_string(FTGFirst_Name, 1, 0, kStringRangeFrom, kNo, kNo, kNo, "", kMandatory)) Then validationFailed = true End If If (not check_string(FTGLast_Name, 1, 0, kStringRangeFrom, kNo, kNo, kNo, "", kMandatory)) Then validationFailed = true End If If (not check_email(FTGEmail, kMandatory)) Then validationFailed = true End If If (not check_string(FTGContact_Number, 1, 0, kStringRangeFrom, kNo, kNo, kNo, "", kMandatory)) Then validationFailed = true End If If (not check_string(FTGSubject, 1, 0, kStringRangeFrom, kNo, kNo, kNo, "", kMandatory)) Then validationFailed = true End If If (not check_string(FTGQuestions, 1, 0, kStringRangeFrom, kNo, kNo, kNo, "", kMandatory)) Then validationFailed = true End If '==================================================== ' Code: ErrorRedirect = '==================================================== If (validationFailed = true) Then Response.Redirect "../error.htm" Response.End End If ' Owner Email: aspEmail emailSubject = FilterCchar("" & FTGEnquiries & " - from Mind Your Weight Website") emailBodyText = "" & vbCrLf _ & "Enquiries : " & FTGEnquiries & "" & vbCrLf _ & "First Name : " & FTGFirst_Name & "" & vbCrLf _ & "Last Name : " & FTGLast_Name & "" & vbCrLf _ & "Email : " & FTGEmail & "" & vbCrLf _ & "Contact Number : " & FTGContact_Number & "" & vbCrLf _ & "Company : " & FTGCompany & "" & vbCrLf _ & "" & vbCrLf _ & "Address : " & vbCrLf _ & "" & FTGAddress & "" & vbCrLf _ & "" & vbCrLf _ & "Email Subject : " & FTGSubject & "" & vbCrLf _ & "Questions Comments : " & FTGQuestions & "" & vbCrLf _ & "Subscibe : " & FTGSubscibe & "" & vbCrLf _ & "" & vbCrLf _ & "" & vbCrLf _ & "------------------------------ END OF " & FTGEnquiries & " ------------------------" & vbCrLf _ & "" aspEmail.Host = "mail.mindyourweight.com.au" ' Owner Email: aspEmail emailFrom = FilterCchar(FTGEmail) aspEmail.From = emailFrom aspEMail.AddAddress "info@mindyourweight.com.au", "Mind Your Weight" aspEMail.AddAddress "sandy@soulawaken.com", "Sandy Hounsell" aspEmail.Subject = emailSubject aspEmail.Body = emailBodyText aspEmail.Charset = "ISO-8859-1" aspEmail.ContentTransferEncoding = "8bit" On Error Resume Next aspEmail.Send If Err <> 0 then Response.Write "aspEmail reported an error sending the email. Error: " & Err.Description End If '==================================================== ' Code: SuccessRedirect = '==================================================== Response.Redirect "../success.htm" %>