<%option explicit%>
[an error occurred while processing this directive]
<%
sub ExecuteMail(mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,Orderattachments, Orderattachmentcount)
'*****************************************************************************
' Version 5.00
' CDONTS, ASPMAIL, JMAIL, ASPEMAIL,OCXMAIL, CDOSYS, DUNDAS
' April 3, 2003 MYSQL
'*****************************************************************************
dim mailer
dim mailerror
dim htmlformat
dim i
'my_system=getconfig("xemailsystem")
htmlformat=ucase(emailformat)
on error resume next
If getconfig("xdebug")="Yes" then
Debugwrite "to=" & my_to & "(" & my_toaddress &") from=" & my_from &"("& my_fromaddress &")"
debugwrite "attachments=" & orderattachmentcount
debugwrite body
end if
If ucase(mailtype)="CDONTS" Then
Set Mailer = Server.CreateObject("CDONTS.NewMail")
if err.number<> 0 then
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
exit sub
end if
Mailer.To = my_toaddress
Mailer.From = my_from & " <" & my_fromaddress & ">"
Mailer.Subject = my_subject
Mailer.Body = body
If htmlformat="HTML" then
Mailer.BodyFormat = 0
Mailer.MailFormat = 0
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AttachFile orderattachments(i)
If getconfig("xdebug")="Yes" then
Debugwrite "adding " & orderattachments(i)
end if
next
Orderattachmentcount=0
end if
Mailer.Send
set mailer=nothing
exit sub
end if
if ucase(mailtype)="ASPMAIL" then
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
' response.write "mail error " & err.number
if err.number<> 0 then
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
exit sub
end if
Mailer.AddRecipient my_to, my_toaddress
Mailer.RemoteHost = my_system
Mailer.FromName = my_from
Mailer.FromAddress = my_fromAddress
Mailer.Subject = my_subject
Mailer.BodyText=body
If htmlformat="HTML" then
Mailer.ContentType = "text/html"
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AddAttachment orderattachments(i)
next
end if
If Mailer.SendMail then
set Mailer=nothing
exit sub
else
mailerror= getlang("langmailerror") & " " & my_toaddress
mailerror=mailerror & "
" & mailer.response
HandleMailError mailerror
Set mailer=nothing
exit sub
end if
end if
If ucase(Mailtype) = "JMAIL" Then
Set Mailer = Server.CreateObject("JMail.SMTPMail")
if err.number<> 0 then
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
exit sub
end if
Mailer.ServerAddress = my_system
Mailer.Sender = my_fromAddress
Mailer.SenderName = my_from
Mailer.AddRecipient my_toaddress
Mailer.Subject = my_subject
If htmlformat="HTML" then
Mailer.ContentType = "text/html"
end if
Mailer.Body = body
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AddAttachment orderattachments(i)
next
end if
If Mailer.execute then
set Mailer=nothing
exit sub
else
mailerror= getlang("langmailerror") & " " & my_toaddress
HandleMailError mailerror
set mailer=nothing
exit sub
end if
end if
If ucase(Mailtype) = "ASPEMAIL" Then
Set Mailer = Server.CreateObject("Persits.MailSender")
if err.number<> 0 then
exit sub
end if
Mailer.Host = my_system
Mailer.From = my_fromAddress
Mailer.FromName = my_from
Mailer.AddAddress my_toaddress, my_to
Mailer.Subject = my_subject
If htmlformat="HTML" then
Mailer.IsHTML = TRUE
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AddAttachment orderattachments(i)
next
end if
Mailer.Body = body
If Mailer.Send then
set Mailer=nothing
exit sub
else
mailerror= getlang("langmailerror") & " " & my_toaddress
HandleMailError mailerror
set mailer=nothing
exit sub
end if
end if
If ucase(Mailtype) = "OCXMAIL" Then
Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1")
If htmlformat="HTML" then
dim result
result=Mailer.XHeader ("Content-Type", "text/html")
end if
mailerror = mailer.SendMail(my_system, my_toaddress, my_fromaddress, my_subject, body)
If "" = mailerror Then
Set mailer=nothing
exit sub
Else
mailerror= getlang("langmailerror") & " " & my_toaddress & VbCR & mailerror
HandleMailError mailerror
set mailer=nothing
End If
exit sub
End IF
If ucase(Mailtype) = "DUNDAS" Then
Set mailer = Server.CreateObject("Dundas.Mailer") 'Mailer object
mailer.TOs.Add my_toaddress, my_to
mailer.Subject = my_subject
mailer.SMTPRelayServers.Add my_system
mailer.FromAddress = my_fromaddress
mailer.Fromname = my_from
If htmlformat="HTML" then
Mailer.HTMLBody = body
else
mailer.Body = body
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
mailer.Attachments.Add orderattachments(i)
next
end if
mailer.SendMail
'test for success/failure of the SendMail operation using VBScript's Err object
If Err.Number <> 0 Then
'an error occurred so output the relevant error string
mailerror= getlang("langmailerror") & " " & my_toaddress & " The following error occurred: " & Err.Description
HandleMailError mailerror
End if
Set mailer = Nothing 'release resources
exit sub
End If
'
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
end sub
Sub HandleMailerror (errormsg)
SetSess "mailerror",errormsg
If getconfig("xDebug")="Yes" then
debugwrite errormsg
end if
end sub
%>
<%
'**************************************************************************
' Tell a Friend
' VP-ASP 5.00 Jan 9, 2003
' shoptellafriend.asp?id=xxx
' shoptellafriend.asp
' Sept 29, 2003 add check for numeric on id
'*************************************************************************
Dim CR
CR=GetMailCR
Dim strMessage
Dim sAction
Dim my_to
Dim my_toaddress
Dim my_from
Dim my_fromaddress
Dim my_subject,mailtype
Dim my_system
Dim mailer
Dim my_attachment
Dim body
Dim strCustName
Dim strCustEmail
Dim strFriendsName
Dim strFriendsEmail
Dim id
Dim cPrice
Dim extDescription
Dim ccode
dim mailid, ProductMessage
Dim TellafriendSubject
sError=""
'=======================
' Entry Point
'=======================
id=request("id")
If not isnumeric(id) then
id=""
end if
sAction=Request("Action")
if sAction="" then
sAction=Request("Action.x")
end if
If sAction = "" Then
ShopPageHeader
DisplayForm()
ShopPageTrailer
Else
ValidateData()
if sError = "" Then
SendMail
WriteInfoMessage
else
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
end if
'=======================
' Sub DisplayForm
'=======================
Sub DisplayForm()
GetProductInfo
If sError<>"" then
shopwriteError Serror
end if
shopwriteheader getlang("LangTellaFriendHeader")
response.write "
"
Response.Write("")
Response.Write("")
end Sub
'=======================
' Sub ValidateData
'=======================
Sub ValidateData()
strCustName = Request.Form("CustName")
strCustEmail = Request.Form("CustEmail")
strFriendsName = Request.Form("FriendsName")
strFriendsEmail = Request.Form("FriendsEmail")
strMessage=request("strMessage")
If strCustName = "" Then
sError = sError & getlang("LangYourName") & "
"
End If
If strCustEmail = "" Then
sError = sError & getlang("LangYourEmail") & "
"
else
If Not InStr(strCustEmail, "@") > 1 Then
Serror=Serror & getlang("LangInvalidEmail") & "-" & getlang("Langyouremail") & "
"
end if
end if
If strFriendsName = "" Then
sError = sError & getlang("LangFriendsName") & "
"
End If
If strFriendsEmail = "" Then
sError = sError & getlang("LangFriendsEmail") & "
"
Else
If Not InStr(strFriendsEmail, "@") > 1 Then
Serror=Serror & getlang("LangInvalidEmail") & "-" & getlang("Langfriendsemail") & "
"
end if
end if
If strMessage = "" Then
sError = sError & getlang("LangTellaFriendMessage") & "
"
End If
If Serror<>"" then
Serror= getlang("LangCommonRequired") & "
" & SError
end if
end sub
'=======================
' Sub SendMail
'=======================
Sub SendMail
dim url, ProductMessage, emailformat, acount
dim xmysite
xmysite=getconfig("xmysite")
Emailformat="Text"
ProductMessage=strmessage
url=getconfig("xmysite")
If id="" Then
Productmessage=ProductMessage
ProductMessage=ProductMessage & "
" & URl
TellaFriendSubject= getlang("LangTellAfriendSite")
else
Productmessage=ProductMessage
if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then
url= xMYSITE & "/shopexd.asp?id=" & id
else
url= xMYSITE & "/shopquery.asp?catalogid=" & id
end if
Productmessage=ProductMessage & "
" & url
TellaFriendSubject= getlang("LangTellAfriendProduct")
end if
Productmessage=replace(ProductMessage,"
",vbcrlf)
body=ProductMessage
'debugwrite body
mailtype=getconfig("xemailtype")
my_from=strCustName
my_fromaddress=strCustEmail
my_toaddress=strFriendsEmail
my_to=strFriendsName
my_system=getconfig("xemailsystem")
my_subject=TellaFriendSubject
acount=0
ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,My_attachment,acount
end sub
Sub WriteInfoMessage
ShoppageHeader
shopwriteheader getlang("LangTellafriendinfo")
shoppagetrailer
end sub
Sub GetProductInfo
Dim rs
Dim sql
Dim cnn, url, productmessage
If id="" then
StrMessage= getlang("LangTellafriendSite")
exit sub
end if
Shopopendatabase cnn
sql = "select * from products where catalogid = " & id
set rs = cnn.execute(sql)
' Get product name
extDescription = rs("cname")
rs.close
set rs=nothing
ShopCloseDatabase cnn
ProductMessage= getlang("LangTellAFriendProduct")
ProductMessage = ProductMessage & vbcrlf & extDescription
strMessage=ProductMessage
end sub
%>