Mail-it LLC Quote Request

<%@ LANGUAGE="VBSCRIPT" %> <% option explicit %> <% Response.Buffer = True %> <% 'Declaring Variables Dim smtpserver,youremail,yourpassword,ContactUs_Name,ContactUs_Email Dim ContactUs_Phone,ContactUs_Subject,ContactUs_Fax,ContactUs_Body,Action,IsError ' Edit these 3 values accordingly smtpserver = "mail.serbinprinting.com" youremail = "webmaster@serbinprinting.com" yourpassword = "serbinwm" ' Grabbing variables from the form post ContactUs_Name = Request("ContactUs_Name") ContactUs_Email = Request("ContactUs_Email") ContactUs_Phone = Request("ContactUs_Phone") ContactUs_Subject = Request("ContactUs_Subject") ContactUs_Fax = Request("ContactUs_Fax") ContactUs_Body = Request("ContactUs_Body") Action = Request("Action") ' Used to check that the email entered is in a valid format Function IsValidEmail(Email) Dim ValidFlag,BadFlag,atCount,atLoop,SpecialFlag,UserName,DomainName,atChr,tAry1 ValidFlag = False If (Email <> "") And (InStr(1, Email, "@") > 0) And (InStr(1, Email, ".") > 0) Then atCount = 0 SpecialFlag = False For atLoop = 1 To Len(Email) atChr = Mid(Email, atLoop, 1) If atChr = "@" Then atCount = atCount + 1 If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True Next If (atCount = 1) And (SpecialFlag = False) Then BadFlag = False tAry1 = Split(Email, "@") UserName = tAry1(0) DomainName = tAry1(1) If (UserName = "") Or (DomainName = "") Then BadFlag = True If Mid(DomainName, 1, 1) = "." then BadFlag = True If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True ValidFlag = True End If End If If BadFlag = True Then ValidFlag = False IsValidEmail = ValidFlag End Function %> Mail-it LLC Quote Request

mQuote

<% If Action = "SendEmail" Then ' Here we quickly check/validate the information entered ' These checks could easily be improved to look for more things If IsValidEmail(ContactUs_Email) = "False" Then IsError = "Yes" Response.Write("You did not enter a valid email address.
") End If If ContactUs_Name = "" Then IsError = "Yes" Response.Write("You did not enter a Name.
") End If If ContactUs_Phone = "" Then IsError = "Yes" Response.Write("You did not enter a Subject.
") End If If ContactUs_Body = "" Then IsError = "Yes" Response.Write("You did not enter a Body.
") End If End If ' If there were no input errors and the action of the form is "SendEMail" we send the email off If Action = "SendEmail" And IsError <> "Yes" Then Dim strBody ' Here we create a nice looking html body for the email strBody = strBody & "Form submitted at " & Now() & vbCrLf & "

" strBody = strBody & "IP: " & Request.ServerVariables("REMOTE_ADDR") & vbCrLf & "
" strBody = strBody & "Name" & " : " & " " & Replace(ContactUs_Name,vbCr,"
") & "
" strBody = strBody & "Email" & " : " & " " & Replace(ContactUs_Email,vbCr,"
") & "
" strBody = strBody & "Phone Number" & " : " & " " & Replace(ContactUs_Phone,vbCr,"
") & "
" strBody = strBody & "Fax Number" & " : " & " " & Replace(ContactUs_Fax,vbCr,"
") & "
" strBody = strBody & "Description of the job you need quoted" & ":" & "
" & Replace(ContactUs_Body,vbCr,"
") & "
" strBody = strBody & "" Dim ObjSendMail Set ObjSendMail = CreateObject("CDO.Message") 'This section provides the configuration information for the remote SMTP server. ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network). ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False) ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = youremail ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = yourpassword ObjSendMail.Configuration.Fields.Update 'End remote SMTP server configuration section== ObjSendMail.To = youremail ObjSendMail.CC = "mark@serbinprinting.com" ObjSendMail.Subject = ContactUs_Subject ObjSendMail.From = ContactUs_Email ' we are sending a html email.. simply switch the comments around to send a text email instead ObjSendMail.HTMLBody = strBody 'ObjSendMail.TextBody = strBody ObjSendMail.Send Set ObjSendMail = Nothing ' change the success messages below to say or do whatever you like ' you could do a response.redirect or offer a hyperlink somewhere.. etc etc %>

Your quote request has been sent. Thank You !

<% Else %>

<% End If %>

<% '========================================================================== ' Functions and subroutines. '========================================================================== '-------------------------------------------------------------------------- ' Adds an error message to the list. '-------------------------------------------------------------------------- sub AddErrorMsg(msg) dim n n = UBound(errorMsgs) Redim Preserve errorMsgs(n + 1) errorMsgs(n + 1) = msg end sub '-------------------------------------------------------------------------- ' Extracts the host name from a URL. '-------------------------------------------------------------------------- function GetHost(url) dim i, str GetHost = "" 'Strip down to host or IP address and port number, if any. if Left(url, 7) = "http://" then str = Mid(url, 8) elseif Left(url, 8) = "https://" then str = Mid(url, 9) end if i = InStr(str, "/") if i > 1 then str = Mid(str, 1, i - 1) end if GetHost = str end function '-------------------------------------------------------------------------- ' Returns true if the given string is in the given array. '-------------------------------------------------------------------------- function InList(str, list) dim item InList = false 'Scan the list. for each item in list if str = item then InList = true exit function end if next end function '-------------------------------------------------------------------------- ' Returns true if the given email address is in valid format. '-------------------------------------------------------------------------- function IsValidEmailAddress(addr) dim list, item dim i, c IsValidEmailAddress = true 'Exclude any address with '..'. if InStr(addr, "..") > 0 then IsValidEmailAddress = false exit function end if 'Split email address into the user and domain names. list = Split(addr, "@") if UBound(list) <> 1 then IsValidEmailAddress = false exit function end if 'Check both names. for each item in list 'Make sure the name is not zero length. if Len(item) <= 0 then IsValidEmailAddress = false exit function end if 'Make sure only valid characters appear in the name. for i = 1 to Len(item) c = Lcase(Mid(item, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz&_-.", c) <= 0 and not IsNumeric(c) then IsValidEmailAddress = false exit function end if next 'Make sure the name does not start or end with invalid characters. if Left(item, 1) = "." or Right(item, 1) = "." then IsValidEmailAddress = false exit function end if next 'Check for a '.' character in the domain name. if InStr(list(1), ".") <= 0 then IsValidEmailAddress = false exit function end if end function '-------------------------------------------------------------------------- ' Builds an array of form field names ordered as they were received. ' Note that fields whose name starts with an underscore are ignored. '-------------------------------------------------------------------------- function FormFieldList() dim str, i, name 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 '-------------------------------------------------------------------------- ' Sends email based on mail component. Uses global variables for parameters ' because there are so many. '-------------------------------------------------------------------------- function SendMail() dim mailObj, cdoMessage, cdoConfig dim addrList SendMail = "" 'Send email (CDONTS version). Note: CDONTS 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 if ccToAddr <> "" then mailObj.Value("Reply-To") = Trim(ccToAddr) mailObj.CC = Trim(ccToAddr) elseif replyToAddr <> "" then mailObj.Value("Reply-To") = Trim(replyToAddr) end if mailObj.Subject = subject mailObj.Body = body mailObj.Send set mailObj = Nothing exit function end if 'Send email (CDOSYS version). if mailComp = "CDOSYS" then set cdoMessage = Server.CreateObject("CDO.Message") set cdoConfig = Server.CreateObject("CDO.Configuration") cdoConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 cdoConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpServer cdoConfig.Fields.Update set cdoMessage.Configuration = cdoConfig cdoMessage.From = fromAddr cdoMessage.To = recipients if ccToAddr <> "" then cdoMessage.ReplyTo = Trim(ccToAddr) cdoMessage.CC = Trim(ccToAddr) elseif replyToAddr <> "" then cdoMessage.ReplyTo = Trim(replyToAddr) end if cdoMessage.Subject = subject cdoMessage.HtmlBody = body on error resume next cdoMessage.Send if Err.Number <> 0 then SendMail = "Email send failed: " & Err.Description & "." end if set cdoMessage = Nothing set cdoConfig = Nothing exit function 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.Subject = subject addrList = Split(recipients, ",") for each addr in addrList mailObj.AddRecipient Trim(addr) next if ccToAddr <> "" then mailObj.ReplyTo = Trim(ccToAddr) mailObj.AddRecipientCC Trim(ccToAddr) elseif replyToAddr <> "" then mailObj.ReplyTo = Trim(replyToAddr) end if mailObj.ContentType = "text/html" mailObj.Body = body if not mailObj.Execute then SendMail = "Email send failed: " & mailObj.ErrorMessage & "." end if exit function end if 'Send email (ASPMail version). if mailComp = "ASPMail" then set mailObj = Server.CreateObject("SMTPsvg.Mailer") mailObj.RemoteHost = smtpServer mailObj.FromAddress = fromAddr for each addr in Split(recipients, ",") mailObj.AddRecipient "", Trim(addr) next if ccToAddr <> "" then mailObj.ReplyTo = Trim(ccToAddr) mailObj.AddCC "", Trim(ccToAddr) elseif replyToAddr <> "" then mailObj.ReplyTo = Trim(replyToAddr) end if mailObj.Subject = subject mailObj.ContentType = "text/html" mailObj.BodyText = body if not mailObj.SendMail then SendMail = "Email send failed: " & mailObj.Response & "." end if exit function end if end function %>