<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
'******************** Database Values for Record Source IDs **********************************************
'these values can be used as rsid below and should be fed by query string to this form where possible
'41 AFY
'42 MySistahs
'43 Ambiente Joven
'44 The Media Project
'45 Youth Resource
sitename = "The Media Project"
'******************** Database Values for Record Source IDs **********************************************
'these values can be used as mlid and should be fed by query string to this form where possible
'16 AFY Upate Over 25
'17 AFY Update Under 25
'9 The Media Project
'1 Youth Resources
'3 Ambiente Joven
'4 MySistahs
'******************** Start Functions **********************************************
'function to Fix ASP Apostrophe Bug.
function FixAP(strin)
strout=FixQU(Replace(strin, "'", "''"))
strout=FixQU(Replace(strout, "[", ""))
strout=FixQU(Replace(strout, "]", ""))
strout=FixQU(Replace(strout, "%", ""))
FixAP=fixQU(strout)
end function
'function to Fix ASP Quotation Mark Bug.
function FixQU(strin)
if isnull(strin) or strin="" then exit function
strout=Replace(strin, chr(34), "''")
FixQU=strout
end function
Function IsValidEmail(Email)
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
'function to detect if item is selected
function ismatch(str, val)
selected = false
if str <> "" then
tempstr = split(str,",")
For i=0 to UBound(tempstr)
if trim(tempstr(i)) = val then
selected = true
end if
Next 'move on to the next value
end if
ismatch = selected
end function
Private Function MkPhoneNum(byVal number)
Dim tmp
number = CStr( number )
number = Trim( number )
number = Replace( number, " ", "" )
number = Replace( number, "-", "" )
number = Replace( number, "(", "" )
number = Replace( number, ")", "" )
Select Case Len( number )
Case 7
tmp = tmp & Mid( number, 1, 3 ) & "-"
tmp = tmp & Mid( number, 4, 4 )
Case 10
tmp = tmp & "(" & Mid( number, 1, 3 ) & ") "
tmp = tmp & Mid( number, 4, 3 ) & "-"
tmp = tmp & Mid( number, 7, 4 )
Case 11
tmp = tmp & Mid( number, 1, 1 ) & " "
tmp = tmp & "(" & Mid( number, 2, 3 ) & ") "
tmp = tmp & Mid( number, 5, 3 ) & "-"
tmp = tmp & Mid( number, 8, 4 )
Case Else
MkPhoneNum = Null
Exit Function
End Select
MkPhoneNum = tmp
End Function
'******************** End Functions **********************************************
haserr = "n"
if request("issubmit")= "yes" then
mailinglist = request("mailinglist")
if mailinglist = "" then
mailinglist = null
end if
FirstName = request("FirstName")
'check required field
if FirstName = "" then
Firstname = "Anonymous"
else
'replace invalid character
FirstName = trim(FirstName)
FirstName = FixAP(FirstName)
end if
LastName = request("LastName")
'check required field
if LastName = "" then
LastName = "Anonymous"
else
'replace invalid characters
LastName = trim(LastName)
LastName = FixAP(LastName)
end if
if request("anon") = "yes" then
FirstName = "Anonymous"
LastName = "Anonymous"
end if
title = request("title")
if title = "" then
title = null
end if
email = request("email")
'check required field
if email = "" then
haserr = "y"
emailERR = "Please provide your email address. "
end if
if Not isvalidemail(email) then
haserr = "y"
emailERR = emailERR & "Please provide a valid email address."
end if
if email <> request("email2") then
haserr = "y"
email2ERR = "Your email addresses do not match, please re-enter."
end if
HomePhone = trim(request("HomePhone"))
HomePhone = FixAP(HomePhone)
if HomePhone <> "" then
newHomePhone = MkPhoneNum(HomePhone)
if newHomePhone = "" then
haserr = "y"
HomePhoneERR = "Please provide a valid phone number."
else
HomePhone = newHomePhone
end if
end if
if homephone = "" then
homephone = null
end if
Department = trim(request("Department"))
Department = FixAP(Department)
if Department = "" then
Department = null
end if
Address1 = trim(request("Address1"))
Address1 = FixAP(Address1)
if address1 = "" then
address1 = null
end if
Address2 = trim(request("Address2"))
Address2 = FixAP(Address2)
if Address2 = "" then
Address2 = NULL
end if
City = trim(request("City"))
City = FixAP(City)
if city = "" then
city = null
end if
aState = request("aState")
if aState = "" then
haserr = "y"
astateerr = "Please choose a state."
end if
PostalCode = trim(request("PostalCode"))
PostalCode = fixap(PostalCode)
if postalcode = "" then
haserr = "y"
postalcodeerr = "Please enter your postal code."
end if
Country = trim(request("Country"))
if country = "" then
country = null
end if
aType = request("aType")
if atype = "" then
atype = null
end if
Age = request("Age")
age = cint(age)
if age = "" then
haserr = "y"
ageerr = "Please select your age group."
end if
Interest = request("Interest")
if interest = "" then
interest = null
end if
Comment = request("Comment")
Comment = trim(comment)
Comment = fixap(comment)
if comment = "" then
comment = null
end if
if haserr = "n" then
'determine if they should receive adult or youth version of Advocates Newsletter based on age selection.
if age = 25 then
mailinglist = replace(mailinglist,"9999"," 16")
else
mailinglist = replace(mailinglist,"9999"," 17")
end if
'make database connection
set conn = server.createobject("ADODB.Connection")
Conn.Open "DSN=AFYContacts;uid=laurie;pwd=helleau1" 'make connection
'sSql = "sp_web_processwebform '" & firstname & "','" & lastname & "','" & Department & "','" & birthdate & "','" & Address1 & "','" & Address2 & "','" & city & "','" & astate & "','" & postalcode & "','" & country & "','" & homephone & "','" & comment & "','" & aType & "'"
'response.write ssql
'Conn.Execute(sSql) 'execute sql call
Set cmd = Server.CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = "sp_web_processwebform_alt"
cmd.CommandType = 4
cmd.Parameters.Append cmd.CreateParameter("sitename", 200,1,80,sitename)
cmd.Parameters.Append cmd.CreateParameter("mailinglist", 200,1,80,mailinglist)
'cmd.Parameters.Append cmd.CreateParameter("rsid", 2,1,2,rsid)
cmd.Parameters.Append cmd.CreateParameter("firstname", 200,1,30,firstname)
cmd.Parameters.Append cmd.CreateParameter("lastname", 200,1,50,lastname)
cmd.Parameters.Append cmd.CreateParameter("email", 200,1,80,email)
cmd.Parameters.Append cmd.CreateParameter("homephone", 200,1,15,homephone)
cmd.Parameters.Append cmd.CreateParameter("department", 200,1,80,department)
cmd.Parameters.Append cmd.CreateParameter("address1", 200,1,80,address1)
cmd.Parameters.Append cmd.CreateParameter("address2", 200,1,80,address2)
cmd.Parameters.Append cmd.CreateParameter("city", 200,1,50,city)
cmd.Parameters.Append cmd.CreateParameter("astate", 200,1,2,astate)
cmd.Parameters.Append cmd.CreateParameter("postalcode", 200,1,15,postalcode)
cmd.Parameters.Append cmd.CreateParameter("country", 200,1,30,country)
cmd.Parameters.Append cmd.CreateParameter("aType", 200,1,80,aType)
cmd.Parameters.Append cmd.CreateParameter("age",2,1,2,age)
cmd.Parameters.Append cmd.CreateParameter("Interest", 200,1,80,interest)
cmd.Parameters.Append cmd.CreateParameter("comment", 200,1,255,comment)
cmd.Execute()
'cmd.Parameters.refresh
set cmd = nothing
conn.close
set conn = nothing
'send email
'*********************************************
'****************************************************
' Customize this section
'****************************************************
' email SMTP server
emailserver = "10.1.1.146"
' email address to where you want this form submitted
emailto = "web@advocatesforyouth.org"
' subject of email
subject = "The Media Project Submission Acknowledgement"
'****************************************************
emailbody = "This is message is to notify you that we have received your submission from the The Media Project website.
"
emailbody = emailbody & "You will soon begin to receive the newsletters from TheMediaProject.com.
"
emailbody = emailbody & "Sincerely, Advocates for Youth"
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") = emailserver
cdoConfig.Fields.Update
set cdoMessage.Configuration = cdoConfig
cdoMessage.From = "web@advocatesforyouth.org"
cdoMessage.To = email
cdoMessage.Subject = subject
cdoMessage.HtmlBody = emailbody
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
end if 'if haserr = "n"
end if 'end if issubmit = "yes"
%>
Send this page to a friend