<%@ LANGUAGE="VBScript" %>
<% '**************************************************************************
'* Based on ASP FormMail by Mike Hall. *
'* Please see http://www.brainjar.com for documentation and terms of use. *
'**************************************************************************
'Initialize.
show_form = true
Response.Buffer = true
errorMsgs = Array()
modal = ""
If Request.Querystring("_modal") <> "" or Request.Form("_modal") <> "" Then
modal = "true"
End If
If Request.Form("_submitted") Then '
'- Customization of these values is required, see documentation. ----------
recipients = Array("75@cbc.ca")
'ENG goes to 75@cbc.ca
'FRA goes to 75@radio-canada.ca
mailComp = "CDONTS"
smtpServer = "cbc.radio-canada.ca"
fromAddr = "forms@cbc.radio-canada.ca"
subject = "Send Us Your Wishes form submission from CBC/Radio-Canada 75th Anniversary website"
required_fields = Array("Name", "Email Address", "Wishes")
field_order = Array()
allowedHosts = Array("www.cbc.radio-canada.ca", "cbc.radio-canada.ca")
allowedRecipients = Array()
allowedEnvars = Array("HTTP_USER_AGENT", "REMOTE_ADDR", "REMOTE_USER")
allowCcToFlag = true
botCheckFlag = false
botCheckID = "MyBotCheckID"
botCheckMinTime = 5
'- End required customization section. ------------------------------------
'Check for form data.
if Request.ServerVariables("Content_Length") = 0 then
call AddErrorMsg("No form data submitted.")
end if
'If bot checking is enabled, check the elapsed time.
if botCheckFlag then
startTime = Session(botCheckID)
if not IsDate(startTime) then
call AddErrorMsg("Invalid submission.")
elseif DateDiff("s", startTime, Now()) < botCheckMinTime then
call AddErrorMsg("Invalid submission.")
end if
end if
'Check if the referering host is allowed.
if UBound(allowedHosts) >= 0 then
host = GetHost(Request.ServerVariables("HTTP_REFERER"))
if host = "" then
call AddErrorMsg("No referer.")
elseif not InList(host, allowedHosts) then
call AddErrorMsg("Unauthorized host: '" & host & "'.")
end if
end if
'Check the email recipients.
if UBound(recipients) > 0 then
call AddErrorMsg("No email recipient(s) specified.")
else
for each addr in recipients
addr = Trim(addr)
if not IsValidEmailAddress(addr) then
call AddErrorMsg("Invalid email address in recipient list: " & addr & ".")
elseif UBound(allowedRecipients) >= 0 then
if not inList(addr, allowedRecipients) then
call AddErrorMsg("Unauthorized email address in recipient list: " & addr & ".")
end if
end if
next
recipients = Join(recipients, ",")
end if
'If required fields are specified, check them.
if UBound(required_fields) > 0 then
for each name in required_fields
name = Trim(name)
if Left(name, 1) <> "_" and Request.Form(name) = "" then
call AddErrorMsg("Missing value for " & name)
end if
next
end if
' Check the submitted email address
if Request.Form("Email Address") <> "" then
if not IsValidEmailAddress(Request.Form("Email Address")) then
call AddErrorMsg("Invalid email address: " & Request.Form("Email Address") & ".")
end if
end if
'If a field order was given, use it. Otherwise use the order the fields were received in.
str = ""
if UBound(field_order) > 0 then
for each name in field_order
if str <> "" then
str = str & ","
end if
str = str & Trim(name)
next
field_order = Split(str, ",")
else
field_order = 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 = "
" & vbCrLf
for each name in field_order
body = body _
& "
" _
& "
" & name & ":
" _
& "
" & Request.Form(name) & "
" _
& "
" & vbCrLf
next
body = body & "
" & vbCrLf
'Add a table for any requested environment variables.
if Request.Form("_envars") <> "" then
body = body _
& "
" & vbCrLf _
& "
" & vbCrLf
envars = Split(Request.Form("_envars"), ",")
for each name in envars
name = Trim(name)
'Only show environment variables in the permitted list.
showEnvar = true
if UBound(allowedEnvars) >= 0 then
showEnvar = InList(name, allowedEnvars)
end if
if showEnvar then
body = body _
& "
" _
& "
" & name & ":
" _
& "
" & Request.ServerVariables(name) & "
" _
& "
" & vbCrLf
end if
next
body = body & "
" & vbCrLf
end if
'Send it.
str = SendMail()
if str <> "" then
AddErrorMsg(str)
else
'Clear the bot check timestamp.
Session.Contents.Remove(botCheckID)
end if
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, cdoWishes, 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 cdoWishes = Server.CreateObject("CDO.Wishes")
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 cdoWishes.Configuration = cdoConfig
cdoWishes.From = fromAddr
cdoWishes.To = recipients
if ccToAddr <> "" then
cdoWishes.ReplyTo = Trim(ccToAddr)
cdoWishes.CC = Trim(ccToAddr)
elseif replyToAddr <> "" then
cdoWishes.ReplyTo = Trim(replyToAddr)
end if
cdoWishes.Subject = subject
cdoWishes.HtmlBody = body
on error resume next
cdoWishes.Send
if Err.Number <> 0 then
SendMail = "Email send failed: " & Err.Description & "."
end if
set cdoWishes = 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.ErrorWishes & "."
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 %>
<% End If ' %>
CBC/Radio-Canada | 75 | Yours To Celebrate | Contact Us
<% If modal <> "" Then %>
<% End if %>
<%
If Request.Form("_submitted") Then '
if UBound(errorMsgs) >= 0 then
' Show errors
%>
Error
Form could not be processed due to the following errors:
<% for each msg in errorMsgs %>
<% = msg %>
<% next %>
<% else
' Show success message, with information sent - but don't show the form
show_form = false
%>
Thank You!
The following information has been sent:
<% for each name in field_order %>
<% = name %>
<% = Request.Form(name) %>
<% next %>
<% end if
End If '
%>
<% If show_form = true Then' %>