<%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 "" end if Response.Write "

" & getlang("LangTellaFriendHeader") & "

" Response.Write "
" Response.Write(TableDef) Response.Write("
") Response.Write(TableDef) CreateCustRow getlang("langYourName"), "Custname", strCustname,"Yes" CreateCustRow getlang("langYourEmail"), "Custemail", strCustemail,"Yes" CreateCustRow getlang("langFriendsname"), "Friendsname", strFriendsname,"Yes" CreateCustRow getlang("langFriendsemail"), "Friendsemail", strfriendsemail,"Yes" response.write tablerow & tablecolumn & getlang("LangTellaFriendMessage") & tablecolumnend response.write tablecolumn response.write "" response.write tablecolumnend & tablerowend 'VP-ASP 6.50 - add a random string to email form to stop bots spamming it if getconfig("xprotectemailforms") = "Yes" then CreateCAPTCHA end if Response.Write(tabledefend) Response.Write "
" 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 %>