SearchBliss Form to Mail Generator and free script

Email Address (The form information will be sent here e. g. webmaster@searchbliss.com)
Form Heading (Text displayed above form)
Customize the small section on the right >> Do not change or alter any other portions of the code (Needed to send form information) EXAMPLE: referers = Array("searchbliss.com") mailComp = "ASPMail" smtpServer ="mail.burlee.com" fromAddr ="guest@searchbliss.com"	<%@ LANGUAGE="VBScript" %> <% '************************************************************************* ' formmail.asp ' Copyright 1999 by Mike Hall. ' Web address: http://www.brainjar.com ' Last update: October 18, 1999. '************************************************************************* '- Customize these values ----------- referers = Array("yoursite.com") mailComp = "ASPMail" smtpServer = "mail.yourserver.com" fromAddr = "guest@yoursite.com" '- End customization section. ---------- Response.Buffer = true errorMsgs = Array() 'Check for form data. if Request.ServerVariables("Content_Length") = 0 then call AddErrorMsg("No form data submitted.") end if 'Check for valid referer. validReferer = false referer = Request.ServerVariables("HTTP_REFERER") referer = Mid(referer, len("http://") + 1) i = InStr(referer, "/") if i > 1 then referer = Mid(referer, 1, InStr(referer, "/") - 1) referer = Mid(referer, InStr(referer, ".") + 1) for each domain in referers if domain = referer then validReferer = true end if next end if if not validReferer then call AddErrorMsg("Invalid referer.") end if 'Check for recipients field. if Request.Form("_recipients") = "" then call AddErrorMsg("Missing email recipient.") end if 'Check all recipient email addresses. recipients = Split(Request.Form("_recipients"), ",") for each name in recipients name = Trim(name) if not IsValidEmail(name) then call AddErrorMsg("Invalid email address in recipient list: " & name & ".") end if next recipients = Join(recipients, ",") 'Get replyTo email address from specified field if given and check it. name = Trim(Request.Form("_replyToField")) if name <> "" then replyTo = Request.Form(name) else replyTo = Request.Form("_replyTo") end if if replyTo <> "" then if not IsValidEmail(replyTo) then call AddErrorMsg("Invalid email address in reply-to field: " & replyTo & ".") end if end if 'Get subject text. subject = Request.Form("_subject") 'If required fields are specified, check for them. if Request.Form("_requiredFields") <> "" then required = Split(Request.Form("_requiredFields"), ",") for each name in required name = Trim(name) if Left(name, 1) <> "_" and Request.Form(name) = "" then call AddErrorMsg("Missing value for " & name) end if next end if 'If a field order was given, use it. Otherwise use the order the fields were 'received in. if Request.Form("_fieldOrder") <> "" then fieldOrder = Split(Request.Form("_fieldOrder"), ",") for each name in fieldOrder name = Trim(name) next else fieldOrder = FormFieldList() end if 'If there were no errors, build the email note and send it. if UBound(errorMsgs) < 0 then 'Build table of form fields and values. body = "<table border=0 cellpadding=2 cellspacing=0>" & vbCrLf for each name in fieldOrder body = body _ & "<tr valign=top>" _ & "<td><font face=""Arial,Helvetica"" size=2><b>" _ & name _ & ": </b></font></td>" _ & "<td><font face=""Arial,Helvetica"" size=2>" _ & Request.Form(name) _ & "</font></td>" _ & "</tr>" & vbCrLf next body = body & "</table>" & vbCrLf 'Add a table with any environmental variables. if Request.Form("_envars") <> "" then body = body _ & "<p>" _ & "<table border=0 cellpadding=2 cellspacing=0>" & vbCrLf envars = Split(Request.Form("_envars"), ",") for each name in envars name = Trim(name) body = body _ & "<tr valign=top>" _ & "<td><font face=""Arial,Helvetica"" size=2><b>" _ & name _ & ": </b></font></td>" _ & "<td><font face=""Arial,Helvetica"" size=2>" _ & Request.ServerVariables(name) _ & "</font></td>" _ & "</tr>" & vbCrLf next body = body & "</table>" & vbCrLf end if 'Send it. str = SendMail() if str <> "" then AddErrorMsg(str) end if 'Redirect if a URL was given. if Request.Form("_redirect") <> "" then Response.Redirect(Request.Form("_redirect")) end if end if %>
IGNORE THIS FIELD >	Do Not Alter This Field!!! <% sub AddErrorMsg(msg) dim n 'Add an error message to the list. n = UBound(errorMsgs) Redim Preserve errorMsgs(n + 1) errorMsgs(n + 1) = msg end sub function SendMail() dim mailObj 'Send email based on mail component. Uses global variables for parameters 'because there are so many. SendMail = "" 'Send email (CDONTS version), doesn't support reply to address and has 'no error checking. if mailComp = "CDONTS" then set mailObj = Server.CreateObject("CDONTS.NewMail") mailObj.BodyFormat = 0 mailObj.MailFormat = 0 mailObj.From = fromAddr mailObj.To = recipients mailObj.Subject = subject mailObj.Body = body mailObj.Send end if 'Send email (JMail version). if mailComp = "JMail" then set mailObj = Server.CreateObject("JMail.SMTPMail") mailObj.Silent = true mailObj.ServerAddress = smtpServer mailObj.Sender = fromAddr mailObj.ReplyTo = replyTo mailObj.Subject = subject addrList = Split(recipients, ",") for each addr in addrList mailObj.AddRecipient Trim(addr) next mailObj.ContentType = "text/html" mailObj.Body = body if not mailObj.Execute then SendMail = "Email send failed: " & mailObj.ErrorMessage & "." end if end if 'Send email (ASPMail version). if mailComp = "ASPMail" then set mailObj = Server.CreateObject("SMTPsvg.Mailer") mailObj.FromAddress = fromAddr mailObj.RemoteHost = smtpServer mailObj.ReplyTo = replyTo for each addr in Split(recipients, ",") mailObj.AddRecipient "", Trim(addr) next mailObj.Subject = subject mailObj.ContentType = "text/html" mailObj.BodyText = body if mailObj.SendMail then SendMail = "" else SendMail = "Email send failed: " & mailObj.Response & "." end if end if end function function IsValidEmail(email) dim names, name, i, c 'Check for valid syntax in an email address. IsValidEmail = true names = Split(email, "@") if UBound(names) <> 1 then IsValidEmail = false exit function end if for each name in names if Len(name) <= 0 then IsValidEmail = false exit function end if for i = 1 to Len(name) c = Lcase(Mid(name, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then IsValidEmail = false exit function end if next if Left(name, 1) = "." or Right(name, 1) = "." then IsValidEmail = false exit function end if next if InStr(names(1), ".") <= 0 then IsValidEmail = false exit function end if i = Len(names(1)) - InStrRev(names(1), ".") if i <> 2 and i <> 3 then IsValidEmail = false exit function end if if InStr(email, "..") > 0 then IsValidEmail = false end if end function function FormFieldList() dim str, i, name 'Build an array of form field names ordered as they were received. str = "" for i = 1 to Request.Form.Count for each name in Request.Form if Left(name, 1) <> "_" and Request.Form(name) is Request.Form(i) then if str <> "" then str = str & "," end if str = str & name exit for end if next next FormFieldList = Split(str, ",") end function %> Do Not Alter This Field!!!
SearchBliss / 2001	Copy and paste code into a BLANK page and save as an ASP file named "mail" (mail.asp )