<%
Dim strUsername, strFrom, strTo, aryTo, maxlen
strUsername = Cstr(request.form("username"))
strFrom = Cstr(replace(request.form("fromemail")," ",""))
strTo = Cstr(replace(request.form("toemail")," ",""))
aryTo = split(strTo,",")
maxlen = ubound(aryTo)
if session("schoolID") <> "" then
schoolID = session("schoolID")
schoolname = session("schoolname")
end if
Dim flag_strFrom, flag_strTo
flag_strFrom = 0
flag_strTo = 0
' validate email address
if strFrom <> "" then
blnValidEmail = RegExpTest(strFrom)
if blnValidEmail then flag_strFrom = 1
end if
Dim counter
for counter=0 to maxlen
if aryTo(counter) <> "" then
blnValidEmail = RegExpTest(aryTo(counter))
if blnValidEmail then
flag_strTo = 1
else
flag_strTo = 0
exit for
end if
end if
next
' Set up new email
if flag_strFrom = 1 and flag_strTo = 1 then
strTo = ""
dim objRec
Set objRec = Server.createobject("ADODB.Recordset")
objRec.Open "UserEmail",strConnect,adOpenDynamic,adLockOptimistic
objRec.AddNew
objRec("EmailAddress") = strFrom
objRec.Update
for counter=0 to maxlen
if aryTo(counter)<>"" then
'insert email address to database
objRec.AddNew
objRec("EmailAddress") = aryTo(counter)
objRec.Update
strTo = strTo + aryTo(counter) + ";"
end if
next
objRec.close
set objRec = nothing
strTo = left(strTo, len(strTo)-1)
'response.write "from: "&strFrom&"
"
'response.write "send to: "&strTo&"
"
Dim myMail, iConf, Flds
Const cdoSendUsingPort = 2
Set myMail = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "216.211.197.35"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Update
End With
HTML = "" & vbCrLf
HTML = HTML & ""
HTML = HTML & ""
HTML = HTML & ""
HTML = HTML & "Sample NewMail"
HTML = HTML & ""
HTML = HTML & ""
HTML = HTML & "
Your friend "&strUsername&" would like to invite you to visit "
if schoolname <> "" and schoolID <> "" then
HTML = HTML & "studyworld.com to share his/her opinion on your teachers in " & schoolname & ".
"
else
HTML = HTML & "studyworld.com to share his/her opinion on your teachers."
end if
HTML = HTML & ""
with myMail
Set .Configuration = iConf
.From = strFrom
.To = strTo
.Subject = "Message from your friend - " & strUsername
'.BodyFormat = 0
'.MailFormat = 0
.HTMLBody = HTML
.Send
end with
Set myMail = Nothing
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
response.redirect("thankyou.asp")
else
response.redirect("referral.asp?action=noinfo&username='"&request.form("username")&"'&fromemail='"&request.form("fromemail")&"'&toemail='"&request.form("toemail")&"'")
end if
Function RegExpTest(sEmail)
RegExpTest = false
Dim regEx, retVal
Set regEx = New RegExp ' Create regular expression:
' Set pattern
regEx.Pattern ="^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$"
' Set case sensitivity
regEx.IgnoreCase = true
' Execute the search test
retVal = regEx.Test(sEmail)
If not retVal Then
exit function
End If
RegExpTest = true
End Function
%>