<%@ LANGUAGE="VBScript" %> <% Option Explicit Dim strErr Dim intSessionID Dim blnReturn Dim strAge Dim strEmail Dim strFirstName Dim strLastName Dim strStreetAddress Dim strCity Dim strState Dim strZipCode Response.Redirect("http://www.thetruthforyouth.com/tfy_bibles.asp") Response.End intSessionID = Request.QueryString("sid") 'if there is data in session id, they are posting to the page If intSessionID <> "" Then If intSessionID = CStr(Session.SessionID) Then 'ready to get data from the form strAge = Trim(Request.Form("cmbage")) strEmail = Trim(Request.Form("txtemail")) strFirstName = Trim(Request.Form("txtfirstname")) strLastName = Trim(Request.Form("txtlastname")) strStreetAddress = Trim(Request.Form("txtstreetaddress")) strCity = Trim(Request.Form("txtcity")) strState = Trim(Request.Form("cmbstate")) strZipCode = Trim(Request.Form("txtzipcode")) 'ready to validate If ValidateFieldRequired(strAge) = False Then strErr = strErr & "
  • Age is a required field.
    • " If ValidateEmail(strEmail) = False Then strErr = strErr & "
  • A valid e-mail address is required.
    • " If ValidateFieldRequired(strFirstName) = False Then strErr = strErr & "
  • First Name is a required field.
    • " If ValidateFieldRequired(strLastName) = False Then strErr = strErr & "
  • Last Name is a required field.
    • " If ValidateFieldRequired(strStreetAddress) = False Then strErr = strErr & "
  • Street Address is a required field.
    • " If ValidateFieldRequired(strCity) = False Then strErr = strErr & "
  • City is a required field.
    • " If ValidateFieldRequired(strState) = False Then strErr = strErr & "
  • State is a required field.
    • " If ValidateFieldNumeric(strZipCode) = False Then strErr = strErr & "
  • Zip Code is a required numeric field.
    • " Else If Len(strZipCode) <> 5 Then strErr = strErr & "
  • Zip Code must be five digits.
    • " End If End If 'check for any errors, if none: save to database If strErr = "" Then blnReturn = CreateSignup(strAge, strEmail, strFirstName, strLastName, strStreetAddress, strCity, strState, strZipCode, Request.ServerVariables("REMOTE_ADDR")) If blnReturn Then Response.Redirect("http://www.thetruthforyouth.com/order_recvd.htm") Else strErr = "
  • We could not process your information at this time. Please contact our webmaster." End If End If End If End If %> The Truth For Youth
    Revival Fires International
    NATIONAL TRUTH FOR YOUTH WEEK ON
    AMERICAN FAMILY RADIO
    SEPTEMBER 8 - 12


    You must be 12-18 years old to receive a free Truth for Youth Bible to give away in school. If you are older or younger than 12-18 you may order the Truth for Youth Bibles at a special discounted price by clicking here.

    Parents may order on behalf of teenagers in their home only.
    <% If strErr <> "" Then %> <% End If %>
    All fields below must be completed to receive your Bible.
      <%= strErr %>
    Age:  
    Email Address:  
    First Name:  
    Last Name:  
    Street Address:  
    City:  
    State:  
    Zip:  
     

     

    <% Function ValidateFieldRequired(ByVal FieldValue) 'check to make sure the field has a value If Trim(FieldValue) = "" Then ValidateFieldRequired = False Else ValidateFieldRequired = True End If End Function Function ValidateFieldNumeric(ByVal FieldValue) Dim lngStart 'make sure data exists If FieldValue = "" Then ValidateFieldNumeric = False Exit Function End If ' Check For numbers only lngStart = 1 Do While lngStart <= Len(FieldValue) If InStr("0123456789", Mid(FieldValue, lngStart, 1)) Then lngStart = lngStart + 1 Else ValidateFieldNumeric = False Exit function End if Loop ValidateFieldNumeric = True End Function Function ValidateEmail(ByRef asString) Dim lsDomain Dim lsSubDomain Dim lsSubDomainArray Dim lbIsIPdomain Dim lnStart Dim lsUserName Dim lnOctect Dim lnOctect2 Dim lnIndex Const lsDOMAIN_CHARACTERS = ".ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-" Const lsUSER_CHARACTERS = ".ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_&" ' Must have at least 6 characters "a@a.ru" if Len(asString) < 6 Then ValidateEmail = False Exit function End if ' Look For "@" delimiter if Not InStr(asString, "@") > 1 Then ValidateEmail = False Exit function End if ' Make sure characters exist after the "@" if Len(asString) = InStr(asString, "@") Then ValidateEmail = False Exit function End if ' Grab domain information "a.ru" lsDomain = UCase(Mid(asString, InStr(asString, "@") + 1)) ' Grab username information lsUserName = UCase(Left(asString, InStr(asString, "@") - 1)) ' Make sure at least 1 "." exists if InStr(lsDomain, ".") = 0 Then ValidateEmail = False Exit function End if ' Check For valid domain characters lnStart = 1 Do While lnStart <= Len(lsDomain) if InStr(lsDOMAIN_CHARACTERS, Mid(lsDomain, lnStart, 1)) Then lnStart = lnStart + 1 Else ValidateEmail = False Exit function End if Loop ' Split domains lsSubDomainArray = Split(lsDomain, ".") lbIsIPdomain = False ' Loop through Each domain For lnIndex = 0 To UBound(lsSubDomainArray, 1) lsSubDomain = lsSubDomainArray(lnIndex) if Len(lsSubDomain) = 0 Then ValidateEmail = False Exit function End if ' Check To see if the domain is an IP Address if lnIndex = 1 Then if IsNumeric(lsSubDomain) Then ' Only IP Addresses can have only numbers In subdomain area lbIsIPDomain = True ' Make sure 4 subdomains are present if Not UBound(lsSubDomainArray, 1) = 3 Then ValidateEmail = False Exit function End if End if End if if lbIsIPDomain Then if Len(lsSubDomain) > 3 Then ValidateEmail = False Exit function ElseIf Not InStr(lsSubDomain, "-") = 0 Then ValidateEmail = False Exit function ElseIf Not IsNumeric(lsSubDomain)Then ValidateEmail = False Exit function End if if lnIndex = UBound(lsSubDomainArray, 1) Then ' Last domain can have 4 characters max if Len(lsSubDomain) > 4 Then ValidateEmail = False Exit function ElseIf Not InStr(lsSubDomain, "-") = 0 Then ValidateEmail = False Exit function End if Else ' Domain, Sub domain can only have 63 characters max if Len(lsSubDomain) > 63 Then ValidateEmail = False Exit function End if End if End if Next ' Check For valid characters In username lnStart = 1 Do While lnStart <= Len(lsUserName) if InStr(lsUSER_CHARACTERS, Mid(lsUserName, lnStart, 1)) Then lnStart = lnStart + 1 Else ValidateEmail = False Exit function End if Loop ValidateEmail = True End function Function IsSelected(NewValue, DBValue) If NewValue = DBValue Then IsSelected = "selected" Else IsSelected = "" End If End Function Function CreateSignup(Age, Email, FirstName, LastName, StreetAddress, City, State, ZipCode, IPAddress) Dim strSQL Dim intReturn Dim objHelper Dim arrOut strSQL = "insert into Signups (Age,Email,FirstName,LastName,StreetAddress,City,State,ZipCode,IPAddress) values (" strSQL = strSQL & "'" & Age & "'," strSQL = strSQL & "'" & Email & "'," strSQL = strSQL & "'" & FirstName & "'," strSQL = strSQL & "'" & LastName & "'," strSQL = strSQL & "'" & StreetAddress & "'," strSQL = strSQL & "'" & City & "'," strSQL = strSQL & "'" & State & "'," strSQL = strSQL & "'" & ZipCode & "'," strSQL = strSQL & "'" & IPAddress & "'" strSQL = strSQL & ")" Set objHelper = New ADOHelper intReturn = objHelper.RunSQL(strSQL) Set objHelper = Nothing If Err.Number <> 0 Then strErr = "
  • System Error: " & Err.Number & "
    " & Err.Description & "
    • " CreateSignup = False Else CreateSignup = True End If End Function %>