<% SendTo = "joseph@onespiritinc.com" MailServer = "mail.korax.net" 'MailServer = "smtp.telusplanet.net" MsgSubject = "Information Request" Function IsEmailValid(strEmail) Dim strArray Dim strItem Dim i Dim c Dim blnIsItValid ' assume the email address is correct blnIsItValid = True ' split the email address in two parts: name@domain.ext strArray = Split(strEmail, "@") ' if there are more or less than two parts If UBound(strArray) <> 1 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If ' check each part For Each strItem In strArray ' no part can be void If Len(strItem) <= 0 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If ' check each character of the part ' only following "abcdefghijklmnopqrstuvwxyz_-." ' characters and the ten digits are allowed For i = 1 To Len(strItem) c = LCase(Mid(strItem, i, 1)) ' if there is an illegal character in the part If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If Next ' the first and the last character in the part cannot be . (dot) If Left(strItem, 1) = "." Or Right(strItem, 1) = "." Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If Next ' the second part (domain.ext) must contain a . (dot) If InStr(strArray(1), ".") <= 0 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If ' check the length oh the extension i = Len(strArray(1)) - InStrRev(strArray(1), ".") ' the length of the extension can be only 2, 3, or 4 ' to cover the new "info" extension If i <> 2 And i <> 3 And i <> 4 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If ' after . (dot) cannot follow a . (dot) If InStr(strEmail, "..") > 0 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If ' finally it's OK IsEmailValid = blnIsItValid End Function If Request("add") <> "" Then Set conn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("../data/members.mdb") If Request("FirstName") & "!" = "!" Then servermsg = servermsg & "- Please provide a First Name
" End If If Request("LastName") & "!" = "!" Then servermsg = servermsg & "- Please provide a Last Name
" End If If Request("Comments") & "!" = "!" Then servermsg = servermsg & "- Please provide a comment/question
" End If If IsEmailValid(Request("Email")) = False Then servermsg = servermsg & "- Please provide a valid Email Address
" End If If servermsg & "!" = "!" Then sql = "Select * From Member;" rs.open sql, conn, 1, 2, 1 rs.addnew rs("FirstName") = Request("FirstName") rs("LastName") = Request("LastName") rs("Email") = Request("Email") rs("Status") = "A" rs("MembershipType") = "1" MemberID = rs("MemberID") rs.update rs.close sql = "Select * From MemberDetails;" rs.open sql, conn, 1, 2, 1 rs.addnew rs("CategoryID") = 13 rs("MemberID") = MemberID rs.update rs.close Set iConf = CreateObject ("CDO.Configuration") Set Flds = iConf.Fields 'Set and update fields properties Flds(cdoSendUsingMethod) = 2 Flds(cdoSMTPServer) = MailServer Flds.Update Set iMesg = CreateObject("CDO.Message") Set iMesg.Configuration = iConf 'Format and send message iMesg.To = SendTo iMesg.From = Request.Form("Email") iMesg.Subject = MsgSubject Message = Request("FirstName") & " " & Request("LastName") & " has requested information..." & vbcrlf & vbcrlf Message = Message & Request("Comments") iMesg.TextBody = Message iMesg.Send 'done send servermsg = servermsg & "Thank You! Your message has been sent.
" End If End If %>