%option explicit%>
<%
'**************************************************************************
' Tell a Friend
' VP-ASP 6.50
' shoptellafriend.asp?id=xxx
' shoptellafriend.asp
' Sept 1, 2004
' April 26, 2005 add translate
'*************************************************************************
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=""
initializesystem
'=======================
' 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()
Dim url
GetProductInfo
If sError<>"" then
shopwriteError Serror
end if
if getconfig("xbreadcrumbs") = "Yes" then
'VP-ASP 6.50.4 - only show breadcrumb part if ID is provided
if id > "" then
if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then
'VP-ASP 6.50.4 - added getconfig around xmysite call
url= getconfig("xMYSITE") & "shopexd.asp?id=" & id
else
'VP-ASP 6.50.4 - added getconfig around xmysite call
url= getconfig("xMYSITE") & "shopquery.asp?catalogid=" & id
end if
end if
response.write "
"
If Getconfig("xbuttoncontinue")="" then
Response.Write("")
else
Response.Write("")
end if
Response.Write "
"
addwebsessform
Response.Write("")
end Sub
'=======================
' Sub ValidateData
'=======================
Sub ValidateData()
'VP-ASP 6.50 - precautionary security fix
strCustName = cleanchars(Request.Form("CustName"))
strCustEmail = cleanchars(Request.Form("CustEmail"))
strFriendsName = cleanchars(Request.Form("FriendsName"))
strFriendsEmail = cleanchars(Request.Form("FriendsEmail"))
strMessage=cleanchars(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
'VP-ASP 6.50 - add a random string to email form to stop bots spamming it
if getconfig("xprotectemailforms") = "Yes" then
%><%
If blnCAPTCHAcodeCorrect Then
'Fine
Else
sError = sError & getlang("langcaptchawrong") & " "
End If
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
'VP-ASP 6.09 - removed slash after xmysite calls
if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then
'VP-ASP 6.50.4 - added getconfig around xmysite call
url= getconfig("xMYSITE") & "shopexd.asp?id=" & id
else
'VP-ASP 6.50.4 - added getconfig around xmysite call
url= getconfig("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
'VP-ASP 6.50.4 - show breadcrumb and back link
dim url
if getconfig("xbreadcrumbs") = "Yes" then
if id > "" then
if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then
url= getconfig("xMYSITE") & "shopexd.asp?id=" & id
else
url= getconfig("xMYSITE") & "shopquery.asp?catalogid=" & id
end if
end if
response.write "
"
end if
shopwriteheader getlang("LangTellafriendinfo")
if id > "" then
if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then
url= getconfig("xMYSITE") & "shopexd.asp?id=" & id
else
url= getconfig("xMYSITE") & "shopquery.asp?catalogid=" & id
end if
response.write "" & getlang("LangCommonBack") & ""
end if
shoppagetrailer
end sub
Sub GetProductInfo
Dim rs
Dim sql
Dim dbc
Dim cnn, url, productmessage
If id="" then
StrMessage= getlang("LangTellafriendSite")
exit sub
end if
ShopopendatabaseP cnn
sql = "select * from products where catalogid = " & id
set rs = cnn.execute(sql)
' Get product name
'VP-ASP 6.091 - don't request data if it doesn't exist
if not rs.eof then
extDescription = rs("cname")
extDescription=translatelanguage(dbc, "products", "cname","catalogid", id, extDescription)
end if
rs.close
set rs=nothing
ShopCloseDatabase cnn
ProductMessage= getlang("LangTellAFriendProduct")
ProductMessage = ProductMessage & vbcrlf & extDescription
strMessage=ProductMessage
end sub
'VP-ASP 6.50 - add a random string to email form to stop bots spamming it
Sub CreateCAPTCHA
if getconfig("xprotectemailforms") <> "Yes" then exit sub
Response.write tablerow & tablecolumn
Response.write "*" & getlang("langcaptchaenter") & TablecolumnEnd
Response.write tablecolumn
getCAPTCHA
Response.write tablecolumnend & tableRowend
End Sub
%>