<% Response.Buffer = true todo = request.querystring errorMsgs = Array() referers = Array("dressorcrane.com", "www.dressorcrane.com") thankyoumessage = "Thank you for taking the time to contact us.
Please allow 24-48 hours for a response." SiteEmail = "don@dressorcrane.com" SenderName = "Dressor Crane Customer Service" emailaddy = request("emailaddress") 'mBCC = "sts@webmastermind.com" EmailTo = "don@dressorcrane.com" emailSubject = "Email sent from dressorcrane.com" emailfooter = "Thank you for visiting us, if you have any other questions visit - http://dressorcrane.com" ' Subroutines and functions. '--------------------------------------------------------------------------- sub AddErrorMsg(msg) dim em 'Add an error message to the list. em = UBound(errorMsgs) Redim Preserve errorMsgs(em + 1) errorMsgs(em + 1) = msg end sub function GetHost(url) dim i, s GetHost = "" 'Strip down to host or IP address and port number, if any. if Left(url, 7) = "http://" then s = Mid(url, 8) elseif Left(url, 8) = "https://" then s = Mid(url, 9) end if i = InStr(s, "/") if i > 1 then s = Mid(s, 1, i - 1) end if getHost = s end function 'Define the global list of valid TLDs. function IsValidEmailAddress(emailAddr) dim i, localPart, domain, charCode, subdomain, subdomains, tld 'Check for valid syntax in an email address. IsValidEmailAddress = true 'Parse out the local part and the domain. i = InStrRev(emailAddr, "@") if i <= 1 then IsValidEmailAddress = false exit function end if localPart = Left(emailAddr, i - 1) domain = Mid(emailAddr, i + 1) if Len(localPart) < 1 or Len(domain) < 3 then IsValidEmailAddress = false exit function end if 'Check for invalid characters in the local part. for i = 1 to Len(localPart) charCode = Asc(Mid(localPart, i, 1)) if charCode < 32 or charCode >= 127 then IsValidEmailAddress = false exit function end if next 'Check for invalid characters in the domain. domain = LCase(domain) for i = 1 to Len(domain) charCode = Asc(Mid(domain, i, 1)) if not ((charCode >= 97 and charCode <= 122) or (charCode >= 48 and charCode <= 57) or charCode = 45 or charCode = 46) then IsValidEmailAddress = false exit function end if next 'Check each subdomain. subdomains = Split(domain, ".") for each subdomain in subdomains if Len(subdomain) < 1 then IsValidEmailAddress = false exit function end if next 'Last subdomain should be a TDL. tld = subdomains(UBound(subdomains)) if not IsArray(validTlds) then call SetValidTlds() end if for i = LBound(validTlds) to UBound(validTlds) if tld = validTlds(i) then exit function end if next IsValidEmailAddress = false end function sub setValidTlds2() 'Load the global list of valid TLDs. validTlds2 = Array("aero", "biz", "com", "coop", "edu", "gov", "info", "int", "mil", "museum", "name", "net", "org", "pro", _ "ac", "ad", "ae", "af", "ag", "ai", "al", "am", "an", "ao", "aq", "ar", "as", "at", "au", "aw", "az", _ "ba", "bb", "bd", "be", "bf", "bg", "bh", "bi", "bj", "bm", "bn", "bo", "br", "bs", "bt", "bv", "bw", "by", "bz", _ "ca", "cc", "cd", "cf", "cg", "ch", "ci", "ck", "cl", "cm", "cn", "co", "cr", "cu", "cv", "cx", "cy", "cz", _ "de", "dj", "dk", "dm", "do", "dz", "ec", "ee", "eg", "eh", "er", "es", "et", _ "fi", "fj", "fk", "fm", "fo", "fr", _ "ga", "gd", "ge", "gf", "gg", "gh", "gi", "gl", "gm", "gn", "gp", "gq", "gr", "gs", "gt", "gu", "gw", "gy", _ "hk", "hm", "hn", "hr", "ht", "hu", _ "id", "ie", "il", "im", "in", "io", "iq", "ir", "is", "it", _ "je", "jm", "jo", "jp", _ "ke", "kg", "kh", "ki", "km", "kn", "kp", "kr", "kw", "ky", "kz", _ "la", "lb", "lc", "li", "lk", "lr", "ls", "lt", "lu", "lv", "ly", _ "ma", "mc", "md", "mg", "mh", "mk", "ml", "mm", "mn", "mo", "mp", "mq", "mr", "ms", "mt", "mu", "mv", "mw ", "mx", "my", "mz", _ "na", "nc", "ne", "nf", "ng", "ni", "nl", "no", "np", "nr", "nu", "nz", _ "om", _ "pa", "pe", "pf", "pg", "ph", "pk", "pl", "pm", "pn", "pr", "ps", "pt", "pw", "py", _ "qa", _ "re", "ro", "ru", "rw", _ "sa", "sb", "sc", "sd", "se", "sg", "sh", "si", "sj", "sk", "sl", "sm", "sn", "so", "sr", "st", "sv", "sy", "sz", _ "tc", "td", "tf", "tg", "th", "tj", "tk", "tm", "tn", "to", "tp", "tr", "tt", "tv", "tw", "tz", _ "ua", "ug", "uk", "um", "us", "uy", "uz", _ "va", "vc", "ve", "vg", "vi", "vn", "vu", _ "wf", "ws", _ "ye", "yt", "yu", _ "za", "zm", "zw") end sub 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 function FillInOurForm() dim fz If Request.Form.Count > 0 Then For fz = 1 to Request.Form.Count Request.Form.Key(fz) = Request.Form.Item(fz) next end if end function Function SendMessage() ' MAILING LIST SYSTEM by IHOST TECHNOLOGIES 2004 ' AUTHORED BY STEVE SPENCER ' MAILING LIST SYSTEM WITH EMAIL CONFIRMATION SYSTEM '============================================================ '---DO THE MAIL STUFF ------------------------------------------------------ Dim iMsg Set iMsg = CreateObject("CDO.Message") Dim iConf Set iConf = CreateObject("CDO.Configuration") Dim Flds Const cdoSendUsingPort = 2 Set Flds = iConf.Fields ' Set the CDOSYS configuration fields to use port 25 on the SMTP server. With Flds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort 'ToDo: Enter name or IP address of remote SMTP server. .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.ihosttech.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10 'Type of authentication, NONE, Basic (Base64 encoded), NTLM .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic 'Your UserID on the SMTP server .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "send@dressorcrane.com" 'Your password on the SMTP server .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "2002$ss" 'Server port (typically 25) .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 26 .Update End With 'Generating the Email --------------------------------- strCC = emailaddy strBCC = mBCC strSubject = emailSubject strBody = StrBody & vbCRLF & vbCRLF strBody = StrBody & "The following email has been sent from " & strURL & vbCRLF & vbCRLF strBody = StrBody & "Your submission follows: " & vbCRLF & vbCRLF dim k If Request.Form.Count > 0 Then For k = 1 to Request.Form.Count if Request.Form.Key(k) = "whocontact" or Request.Form.Key(k) = "_requiredFields" or Request.Form.Key(k) = "_mustbenum" or Request.Form.Key(k) = "_emailcheck" then else strBody = strBody & Request.Form.Key(k) & " : "& Request.Form.Item(k) & vbCRLF end if next end if strBody = StrBody & vbCRLF & emailfooter & vbCRLF 'Generating the Email --------------------------------- SenderName = ListTitle iMsg.To = EmailTo ' iMsg.To = "info@ihosttech.com" iMsg.CC = strCC iMsg.BCC = strBCC iMsg.From = strCC iMsg.Subject = strSubject iMsg.TextBody = strBody iMsg.Send Set iMsg = Nothing Set iConf = Nothing End Function Function WebFormActions if todo = "sendit" then ' response.write "process form..." 'Check for form data. if Request.ServerVariables("Content_Length") = 0 then call AddErrorMsg("No form data submitted.") end if if UBound(referers) >= 0 then validReferer = false referer = GetHost(Request.ServerVariables("HTTP_REFERER")) for each host in referers if host = referer then validReferer = true end if next if not validReferer then if referer = "" then call AddErrorMsg("No referer.") else call AddErrorMsg("Sorry this site: '" & referer & "' cannot submit this form.") end if end if end if if Request.Form("_mustbenum") <> "" then numrequired = Split(Request.Form("_mustbenum"), ",") for each nname in numrequired nname = Trim(nname) if Left(nname, 1) <> "_" and isNaN(Request.Form(nname)) = false then else call AddErrorMsg(Replace(nname,"_"," ") & " must be a number value.") end if next end if 'If required fields are specified, check for them. if Request.Form("_emailcheck") <> "" then required = Split(Request.Form("_emailcheck"), ",") for each ename in required ename = Trim(ename) if IsValidEmailAddress(Request.Form(ename)) = false then call AddErrorMsg("The email provided is not a proper email address.") end if next end if '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 " & Replace(name,"_"," ")) end if next end if 'If a field order was given, use it. Otherwise use the order the fields were 'received in. str = "" if Request.Form("_fieldOrder") <> "" then fieldOrder = Split(Request.Form("_fieldOrder"), ",") for each name in fieldOrder if str <> "" then str = str & "," end if str = str & Trim(name) next fieldOrder = Split(str, ",") else fieldOrder = FormFieldList() end if if UBound(errorMsgs) >= 0 then 'response.write "err..." dim errcontent errcontent = errcontent & "

Your email could not be processed due to the following errors:

" errcontent = errcontent & "

" &msg& "

" WebFormActions = WebFormActions & WebForm(errcontent) else 'response.write "send mess..." SendMessage() WebFormActions = WebFormActions & "

" & thankyoumessage & "

" end if elseif todo = "" then 'response.write "web form..." WebFormActions = WebFormActions & WebForm(noerrors) end if end Function %>

Contact Us


Company:
Street Address:
City / Town:
Province / State:
Country:	Canada	U.S.
Postal / Zip Code:
Contact Person:
Email Address:
Telephone Number:
Nature of Inquiry:
Comments:

Please note that fields in italics are mandatory.

DRESSOR CRANE & HOIST
DIV. OF THE DRESSOR GROUP LTD
400 MOROBEL DR. UN # 3
MILTON, ON. L9T-4N6

TEL (905) 636-9100 . FAX (905) 636-9200

Dressor Crane Accepts Visa and Mastercard!