Hey Mark, Here's the script:
<p><br> <%@ Language="VBScript" CODEPAGE=65001%><br> <% '*************************************************************************** <br> '* ASP FormMail *<br> '* *<br> '* Do not remove this notice. *<br> '* *<br> '* Copyright 1999-2002 by Mike Hall. *<br> '* Please see http://www.brainjar.com for documentation and terms of use. *<br> '*************************************************************************** <br> </p> <p> </p> <p>'- Customization of these values is required, see documentation. -----------<br> referers = Array("www.conceptgroupinc.com", "conceptgroupinc.com")<br> mailComp = "ASPMail"<br> smtpServer = "mail.core.com"<br> fromAddr = "[EMAIL PROTECTED]"<br> '- End required customization section. -------------------------------------<br> </p> <p> </p> <p>Response.Buffer = true<br> errorMsgs = Array()<br> 'Check for form data.<br> if Request.ServerVariables("Content_Length") = 0 then<br> call AddErrorMsg("No form data submitted.")<br> end if<br> 'Check if referer is allowed.<br> if UBound(referers) >= 0 then<br> validReferer = false<br> referer = GetHost(Request.ServerVariables("HTTP_REFERER"))<br> for each host in referers<br> if host = referer then<br> validReferer = true<br> end if<br> next<br> if not validReferer then<br> if referer = "" then<br> call AddErrorMsg("No referer.")<br> else<br> call AddErrorMsg("Invalid referer: '" & referer & "'.")<br> end if<br> end if<br> end if<br> 'Check for the recipients field.<br> if Request.Form("_recipients") = "" then<br> call AddErrorMsg("Missing email recipient.")<br> end if<br> 'Check all recipient email addresses.<br> recipients = Split(Request.Form("_recipients"), ",")<br> for each name in recipients<br> name = Trim(name)<br> if not IsValidEmailAddress(name) then<br> call AddErrorMsg("Invalid email address in recipient list: " & name & ".")<br> end if<br> next<br> recipients = Join(recipients, ",")<br> 'Get replyTo email address from specified field, if given, and check it.<br> name = Trim(Request.Form("_replyToField"))<br> if name <> "" then<br> replyTo = Request.Form(name)<br> else<br> replyTo = Request.Form("_replyTo")<br> end if<br> if replyTo <> "" then<br> if not IsValidEmailAddress(replyTo) then<br> call AddErrorMsg("Invalid email address in reply-to field: " & replyTo & ".")<br> end if<br> end if<br> 'Get subject text.<br> subject = Request.Form("_subject")<br> 'If required fields are specified, check for them.<br> if Request.Form("_requiredFields") <> "" then<br> required = Split(Request.Form("_requiredFields"), ",")<br> for each name in required<br> name = Trim(name)<br> if Left(name, 1) <> "_" and Request.Form(name) = "" then<br> call AddErrorMsg("Missing value for " & name)<br> end if<br> next<br> end if<br> 'If a field order was given, use it. Otherwise use the order the fields were<br> 'received in.<br> str = ""<br> if Request.Form("_fieldOrder") <> "" then<br> fieldOrder = Split(Request.Form("_fieldOrder"), ",")<br> for each name in fieldOrder<br> if str <> "" then<br> str = str & ","<br> end if<br> str = str & Trim(name)<br> next<br> fieldOrder = Split(str, ",")<br> else<br> fieldOrder = FormFieldList()<br> end if<br> 'If there were no errors, build the email note and send it.<br> if UBound(errorMsgs) < 0 then<br> 'Build table of form fields and values.<br> body = "<table border=""0"" cellpadding=""2"" cellspacing=""0"">" & vbCrLf<br> for each name in fieldOrder<br> body = body _<br> & "<tr valign=""top"">" _<br> & "<td><b>" & name & ":</b></td>" _<br> & "<td>" & Request.Form(name) & "</td>" _<br> & "</tr>" & vbCrLf<br> next<br> body = body & "</table>" & vbCrLf<br> 'Add a table for any requested environmental variables.<br> if Request.Form("_envars") <> "" then<br> body = body _<br> & "<p>&nbsp;</p>" & vbCrLf _<br> & "<table border=""0"" cellpadding=""2"" cellspacing=""0"">" & vbCrLf<br> envars = Split(Request.Form("_envars"), ",")<br> for each name in envars<br> name = Trim(name)<br> body = body _<br> & "<tr valign=""top"">" _<br> & "<td><b>" & name & ":</b></td>" _<br> & "<td>" & Request.ServerVariables(name) & "</td>" _<br> & "</tr>" & vbCrLf<br> next<br> body = body & "</table>" & vbCrLf<br> end if<br> 'Send it.<br> str = SendMail()<br> if str <> "" then<br> AddErrorMsg(str)<br> end if<br> 'Redirect if a URL was given.<br> if Request.Form("_redirect") <> "" then<br> Response.Redirect(Request.Form("_redirect"))<br> end if<br> end if %><br> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><br> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"><br> <head><br> <meta http-equiv="Content-Type" content="text/html;charset=utf-8" /><br> <title>Form Mail</title><br> <style type="text/css"><br> body {<br> background-color: #ffffff;<br> color: #000000;<br> font-family: Arial, Helvetica, sans-serif;<br> font-size: 10pt;<br> }<br> table {<br> border: solid 1px #000000;<br> border-collapse: collapse;<br> }<br> td, th {<br> border: solid 1px #000000;<br> border-collapse: collapse;<br> font-family: Arial, Helvetica, sans-serif;<br> font-size: 10pt;<br> padding: 2px;<br> padding-left: 8px;<br> padding-right: 8px;<br> }<br> th {<br> background-color: #c0c0c0;<br> }<br> .error {<br> color: #c00000;<br> }<br> </style><br> </head><br> <body><br> <% if UBound(errorMsgs) >= 0 then %><br> <p class="error">Form could not be processed due to the following errors:</p><br> <ul><br> <% for each msg in errorMsgs %><br> <li class="error"><% = msg %></li><br> <% next %><br> </ul><br> <% else %><br> <table cellpadding="0" cellspacing="0"><br> <tr><br> <th colspan="2" valign="bottom"><br> Thank you, the following information has been sent:<br> </th><br> </tr><br> <% for each name in fieldOrder %><br> <tr valign="top"><br> <td><b><% = name %></b></td><br> <td><% = Request.Form(name) %></td><br> </tr><br> <% next %><br> </table><br> <% end if %><br> </body><br> </html><br> <% '--------------------------------------------------------------------------- <br> ' Subroutines and functions.<br> '--------------------------------------------------------------------------- <br> sub AddErrorMsg(msg)<br> dim n<br> 'Add an error message to the list.<br> n = UBound(errorMsgs)<br> Redim Preserve errorMsgs(n + 1)<br> errorMsgs(n + 1) = msg<br> end sub<br> function GetHost(url)<br> dim i, s<br> GetHost = ""<br> 'Strip down to host or IP address and port number, if any.<br> if Left(url, 7) = "http://" then<br> s = Mid(url, 8)<br> elseif Left(url, 8) = "https://" then<br> s = Mid(url, 9)<br> end if<br> i = InStr(s, "/")<br> if i > 1 then<br> s = Mid(s, 1, i - 1)<br> end if<br> getHost = s<br> end function<br> 'Define the global list of valid TLDs.<br> dim validTlds<br> function IsValidEmailAddress(emailAddr)<br> dim i, localPart, domain, charCode, subdomain, subdomains, tld<br> 'Check for valid syntax in an email address.<br> IsValidEmailAddress = true<br> 'Parse out the local part and the domain.<br> i = InStrRev(emailAddr, "@")<br> if i <= 1 then<br> IsValidEmailAddress = false<br> exit function<br> end if<br> localPart = Left(emailAddr, i - 1)<br> domain = Mid(emailAddr, i + 1)<br> if Len(localPart) < 1 or Len(domain) < 3 then<br> IsValidEmailAddress = false<br> exit function<br> end if<br> 'Check for invalid characters in the local part.<br> for i = 1 to Len(localPart)<br> charCode = Asc(Mid(localPart, i, 1))<br> if charCode < 32 or charCode >= 127 then<br> IsValidEmailAddress = false<br> exit function<br> end if<br> next<br> 'Check for invalid characters in the domain.<br> domain = LCase(domain)<br> for i = 1 to Len(domain)<br> charCode = Asc(Mid(domain, i, 1))<br> if not ((charCode >= 97 and charCode <= 122) or (charCode >= 48 and charCode <= 57) or charCode = 45 or charCode = 46) then<br> IsValidEmailAddress = false<br> exit function<br> end if<br> next<br> 'Check each subdomain.<br> subdomains = Split(domain, ".")<br> for each subdomain in subdomains<br> if Len(subdomain) < 1 then<br> IsValidEmailAddress = false<br> exit function<br> end if<br> next<br> 'Last subdomain should be a TDL.<br> tld = subdomains(UBound(subdomains))<br> if not IsArray(validTlds) then<br> call SetValidTlds()<br> end if<br> for i = LBound(validTlds) to UBound(validTlds)<br> if tld = validTlds(i) then<br> exit function<br> end if<br> next<br> IsValidEmailAddress = false<br> end function<br> sub setValidTlds()<br> 'Load the global list of valid TLDs.<br> validTlds = Array("aero", "biz", "com", "coop", "edu", "gov", "info", "int", "mil", "museum", "name", "net", "org", "pro", _<br> "ac", "ad", "ae", "af", "ag", "ai", "al", "am", "an", "ao", "aq", "ar", "as", "at", "au", "aw", "az", _<br> "ba", "bb", "bd", "be", "bf", "bg", "bh", "bi", "bj", "bm", "bn", "bo", "br", "bs", "bt", "bv", "bw", "by", "bz", _<br> "ca", "cc", "cd", "cf", "cg", "ch", "ci", "ck", "cl", "cm", "cn", "co", "cr", "cu", "cv", "cx", "cy", "cz", _<br> "de", "dj", "dk", "dm", "do", "dz", "ec", "ee", "eg", "eh", "er", "es", "et", _<br> "fi", "fj", "fk", "fm", "fo", "fr", _<br> "ga", "gd", "ge", "gf", "gg", "gh", "gi", "gl", "gm", "gn", "gp", "gq", "gr", "gs", "gt", "gu", "gw", "gy", _<br> "hk", "hm", "hn", "hr", "ht", "hu", _<br> "id", "ie", "il", "im", "in", "io", "iq", "ir", "is", "it", _<br> "je", "jm", "jo", "jp", _<br> "ke", "kg", "kh", "ki", "km", "kn", "kp", "kr", "kw", "ky", "kz", _<br> "la", "lb", "lc", "li", "lk", "lr", "ls", "lt", "lu", "lv", "ly", _<br> "ma", "mc", "md", "mg", "mh", "mk", "ml", "mm", "mn", "mo", "mp", "mq", "mr", "ms", "mt", "mu", "mv", "mw ", "mx", "my", "mz", _<br> "na", "nc", "ne", "nf", "ng", "ni", "nl", "no", "np", "nr", "nu", "nz", _<br> "om", _<br> "pa", "pe", "pf", "pg", "ph", "pk", "pl", "pm", "pn", "pr", "ps", "pt", "pw", "py", _<br> "qa", _<br> "re", "ro", "ru", "rw", _<br> "sa", "sb", "sc", "sd", "se", "sg", "sh", "si", "sj", "sk", "sl", "sm", "sn", "so", "sr", "st", "sv", "sy", "sz", _<br> "tc", "td", "tf", "tg", "th", "tj", "tk", "tm", "tn", "to", "tp", "tr", "tt", "tv", "tw", "tz", _<br> "ua", "ug", "uk", "um", "us", "uy", "uz", _<br> "va", "vc", "ve", "vg", "vi", "vn", "vu", _<br> "wf", "ws", _<br> "ye", "yt", "yu", _<br> "za", "zm", "zw")<br> end sub<br> function FormFieldList()<br> dim str, i, name<br> 'Build an array of form field names ordered as they were received.<br> str = ""<br> for i = 1 to Request.Form.Count<br> for each name in Request.Form<br> if Left(name, 1) <> "_" and Request.Form(name) is Request.Form(i) then<br> if str <> "" then<br> str = str & ","<br> end if<br> str = str & name<br> exit for<br> end if<br> next<br> next<br> FormFieldList = Split(str, ",")<br> end function<br> function SendMail()<br> dim mailObj, cdoMessage, cdoConfig<br> dim addrList<br> 'Send email based on mail component. Uses global variables for parameters<br> 'because there are so many.<br> SendMail = ""<br> 'Send email (CDONTS version). Note: CDONTS has no error checking.<br> if mailComp = "CDONTS" then<br> set mailObj = Server.CreateObject("CDONTS.NewMail")<br> mailObj.BodyFormat = 0<br> mailObj.MailFormat = 0<br> mailObj.From = fromAddr<br> mailObj.Value("Reply-To") = replyTo<br> mailObj.To = recipients<br> mailObj.Subject = subject<br> mailObj.Body = body<br> mailObj.Send<br> set mailObj = Nothing<br> exit function<br> end if<br> 'Send email (CDOSYS version).<br> if mailComp = "CDOSYS" then<br> set cdoMessage = Server.CreateObject("CDO.Message")<br> set cdoConfig = Server.CreateObject("CDO.Configuration")<br> cdoConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendus ing") = 2<br> cdoConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpse rver") = smtpServer<br> cdoConfig.Fields.Update<br> set cdoMessage.Configuration = cdoConfig<br> cdoMessage.From = fromAddr<br> cdoMessage.ReplyTo = replyTo<br> cdoMessage.To = recipients<br> cdoMessage.Subject = subject<br> cdoMessage.HtmlBody = body<br> on error resume next<br> cdoMessage.Send<br> if Err.Number <> 0 then<br> SendMail = "Email send failed: " & Err.Description & "."<br> end if<br> set cdoMessage = Nothing<br> set cdoConfig = Nothing<br> exit function<br> end if<br> 'Send email (JMail version).<br> if mailComp = "JMail" then<br> set mailObj = Server.CreateObject("JMail.SMTPMail")<br> mailObj.Silent = true<br> mailObj.ServerAddress = smtpServer<br> mailObj.Sender = fromAddr<br> mailObj.ReplyTo = replyTo<br> mailObj.Subject = subject<br> addrList = Split(recipients, ",")<br> for each addr in addrList<br> mailObj.AddRecipient Trim(addr)<br> next<br> mailObj.ContentType = "text/html"<br> mailObj.Body = body<br> if not mailObj.Execute then<br> SendMail = "Email send failed: " & mailObj.ErrorMessage & "."<br> end if<br> exit function<br> end if<br> 'Send email (ASPMail version).<br> if mailComp = "ASPMail" then<br> set mailObj = Server.CreateObject("SMTPsvg.Mailer")<br> mailObj.RemoteHost = smtpServer<br> mailObj.FromAddress = fromAddr<br> mailObj.ReplyTo = replyTo<br> for each addr in Split(recipients, ",")<br> mailObj.AddRecipient "", Trim(addr)<br> next<br> mailObj.Subject = subject<br> mailObj.ContentType = "text/html"<br> mailObj.BodyText = body<br> if not mailObj.SendMail then<br> SendMail = "Email send failed: " & mailObj.Response & "."<br> end if<br> exit function<br> end if<br> end function %> </p> ------------------------ Yahoo! Groups Sponsor --------------------~--> $9.95 domain names from Yahoo!. Register anything. http://us.click.yahoo.com/J8kdrA/y20IAA/yQLSAA/saFolB/TM --------------------------------------------------------------------~-> Yahoo! Groups Links <*> To visit your group on the web, go to: http://groups.yahoo.com/group/AspClassicAnyQuestionIsOk/ <*> To unsubscribe from this group, send an email to: [EMAIL PROTECTED] <*> Your use of Yahoo! Groups is subject to: http://docs.yahoo.com/info/terms/
