<%option explicit%>
<%
'**************************************************************************
' Tell a Friend
' VP-ASP 4.00 October 14, 2001
' shoptellafriend.asp?id=xxx
' shoptellafriend.asp
'*************************************************************************
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")
'------------------------------------
' VP-ASP Security Patch - 02/2006
'------------------------------------
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
Response.write getconfig("xfont") & Serror & " "
end if
Response.Write getconfig("xfont") & "" & LangTellaFriendHeader & "
"
Response.Write("
")
Response.Write("
")
Response.Write (" ")
If Getconfig("xbuttoncontinue")="" then
Response.Write("")
else
Response.Write("")
end if
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 & LangYourName & " "
End If
If strCustEmail = "" Then
sError = sError & LangYourEmail & " "
else
If Not InStr(strCustEmail, "@") > 1 Then
Serror=Serror & LangInvalidEmail & "-" & Langyouremail & " "
end if
end if
If strFriendsName = "" Then
sError = sError & LangFriendsName & " "
End If
If strFriendsEmail = "" Then
sError = sError & LangFriendsEmail & " "
Else
If Not InStr(strFriendsEmail, "@") > 1 Then
Serror=Serror & LangInvalidEmail & "-" & Langfriendsemail & " "
end if
end if
If strMessage = "" Then
sError = sError & LangTellaFriendMessage & " "
End If
If Serror<>"" then
Serror=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=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=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
Response.write getconfig("xfont") & LangTellafriendinfo & ""
shoppagetrailer
end sub
Sub GetProductInfo
Dim rs
Dim sql
Dim cnn, url, productmessage
If id="" then
StrMessage=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= LangTellAFriendProduct
ProductMessage = ProductMessage & vbcrlf & extDescription
strMessage=ProductMessage
end sub
%>