<%option explicit%> <%response.buffer=true%> <%ShopOpenDatabase dbc%> <% '********************************************************************************* ' 7.00 ' 1 Dec 2009 ' adds customer Contact form ' Display company information and allows customer to send messages '********************************************************************************* dim my_to, my_toaddress,my_system,my_from,my_fromaddress,my_subject,mailtype dim mailer, my_attachment dim customeradmin '6.09 - adjust to time difference, if required dim newdate, newtime dim sAction, DBTable dim strPassword1, strPassword2 dim body, strsubject,strcomment SetSess "currenturl","shopcustcontact.asp" sAction=Request("Action") if saction="" then sAction=Request("Action.x") end if if GetConfig("xcontactform")<>"Yes" then ShopError GetLang("LangCustNotAllowed") end if SError="" ShopPageHeader '6.09 - added breadcrumb / VP-ASP 6.50 - added config option to turn breadcrumb on/off if GetConfig("xbreadcrumbs") = "Yes" then response.write "
" & GetLang("langcommonhome") & " " & SubCatSeparator & GetLang("langcontactus") & "
" end if if sAction = "" then DisplayForm else '700 - 2010.04.22 - cross site script security enhancement verifygenpredefinedsecuritycode request("genpredefinedsecuritycode") ValidateData() if SError = "" then SendMailToMerchant strsubject WriteInfo DisplayCompanyInfo else DisplayForm end if end if '700 Google Map Displaygooglemap ShopPageTrailer ShopCloseDatabase dbc sub DisplayForm() DisplayMinimumForm DisplayCompanyInfo end sub sub ValidateData '6.50 - precautionary security fix strFirstname = CleanChars(Request.Form("strFirstname")) strEmail = CleanChars(Request.Form("strEmail")) strcomment=CleanChars(request("strcomment")) strsubject=CleanChars(request("strsubject")) strcompany=CleanChars(request("strcompany")) ValidateMininumInfo end sub '700 - 2010.06.11 - Enhancement: code enhancement at shopcustcontact.asp sub WriteInfo %>

<%=GetLang("langcontactus")%>

<%=GetLang("LangTellaFriendInfo")%>
<%=strFirstname%>
<%=strEmail%>
<%=strSubject%>
<%=replace(strcomment, chr(13), "
")%>
<% end sub sub DisplayErrors if SError<> "" then ShopWriteError SError SError="" end if end sub sub SendMailToMerchant (isubject) dim acount dim my_attachment, htmlformat htmlformat="Text" my_attachment="" mailtype=GetConfig("xemailtype") '700 - 2010.06.11 - Enhancement: code enhancement at shopcustcontact.asp my_from=strfirstname my_fromaddress=stremail my_toaddress=GetConfig("xemail") my_to=GetConfig("xemailname") my_system=GetConfig("xemailsystem") my_subject=isubject Body="" '6.09 - adjust to time difference, if required If GetConfig("xTimeDifference")="" then newDate = Date() newTime = Time() else AdjustDate newDate AdjustTime newTime end if body=body & shopdateformat(newdate,GetConfig("xdateformat")) & " " & newtime & vbcrlf & vbcrlf '700 - 2010.06.11 - Enhancement: code enhancement at shopcustcontact.asp Body=Body & Strfirstname & vbcrlf Body=body & stremail & vbcrlf if strcompany<>"" then Body=body & GetLang("LangCustcompany") & " " & strcompany & vbcrlf end if body=body & vbcrlf 'body=body & strcomment 'BUG - Quotation mark entered in a comment turnes into " strcomment = replace(strcomment,"''","'") body=body & replace(strcomment,"""","""""") '2012.08.22 - Bug Fix: Contact us page should not display summary on sent out page 'debugwrite server.HTMLEncode(body) acount=0 ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,htmlformat,my_attachment,acount if GetConfig("xdebug")="Yes" then '700 - 2010.06.11 - Enhancement: code enhancement at shopcustcontact.asp DebugWrite "Mailing to: " & my_to & "(" & my_toaddress & ") from " & strfirstname & " " & stremail end if end sub sub DisplayMinimumForm %>

<%=GetLang("langcontactus")%>

<%DisplayErrors%>
<% '700 - 2010.04.22 - cross site script security enhancement htmlwrite "" %> <% ShopWriteHeaderBox getlang("langplsleavemessage") '700 - 2010.06.11 - Enhancement: code enhancement at shopcustcontact.asp CreateFieldSetRow GetLang("langyourname"), "strfirstname", strFirstname,"No","" CreateFieldSetRow GetLang("langloginemail"), "strEmail", strEmail,"No","" CreateFieldSetRow GetLang("langsubject"), "strsubject", strSubject,"No","" CreateFieldSetTextAreaRow GetLang("langmenucomment"), "strcomment", strcomment,"No","" '6.50 - add a random string to email form to stop bots spamming it if GetConfig("xprotectemailforms") = "Yes" then CreateCAPTCHA end if ShopWriteFooterBox "" %>
<% '701 - 2010.12.29 - Bug Fix: Contact us page button should use shopbutton routine ShopButton GetConfig("xbuttoncontinue"),GetLang("langcommoncontinue"),"action" %>
<% end sub sub ValidateMininumInfo if strFirstname = "" then '700 - 2010.06.11 - Enhancement: code enhancement at shopcustcontact.asp SError = SError & GetLang("langyourname") & GetLang("LangCustrequired") & "
" end if if strEmail = "" then SError = SError & GetLang("LangCustEmail") & GetLang("LangCustrequired") & "
" else CustomerValidateEmail stremail end if if strSubject = "" then SError = SError & GetLang("LangSubject") & GetLang("LangCustrequired") & "
" end if if strComment = "" then SError = SError & GetLang("LangCheckoutadditional") & GetLang("LangCustrequired") & "
" end if '700 - Recaptcha dim blnCAPTCHAcodeCorrect2 if GetConfig("xprotectemailforms") = "Yes" then if lcase(getconfig("xcaptchamethod")) = "recaptcha" then blnCAPTCHAcodeCorrect2 = recaptcha_confirm(request.Form("recaptcha_challenge_field"), request.Form("recaptcha_response_field")) if lcase(blnCAPTCHAcodeCorrect2) = "correct" then 'Fine else SError = SError & GetLang("langcaptchawrong") & "
" end if else %><% if blnCAPTCHAcodeCorrect then 'Fine else sError = sError & getlang("langcaptchawrong") & "
" end if end if End If end sub sub DisplayCompanyInfo dim sql, rs, address, email, myemail sql="select * from mycompany" Set rs = Server.CreateObject("ADODB.Recordset") rs.open sql, dbc, adOpenDynamic, adLockOptimistic if rs.eof then CloseRecordSet rs exit sub end if address=rs("address") & "
" address=address & rs("city") & " " & rs("state") & " " & rs("postalcode") address=address & "
" & rs("country") %>

<%=GetLang("langcommoninformation")%>

<% myemail=rs("myemail") If not isnull(Myemail) then email="" & myemail & "" %> <% end if %> <%'700 - 2010.09.09 - Enhancement: To include mycompany table spare fields%> <%If not isnull(rs("other1")) then%> <%If trim(rs("other1")) <> "" then%> <%end if%> <%end if%> <%If not isnull(rs("other2")) then%> <%If trim(rs("other2")) <> "" then%> <%end if%> <%end if%> <%If not isnull(rs("other3")) then%> <%If trim(rs("other3")) <> "" then%> <%end if%> <%end if%> <%If not isnull(rs("other4")) then%> <%If trim(rs("other4")) <> "" then%> <%end if%> <%end if%>
<%=GetLang("LangCustCompany")%> <%=rs("companyname")%>
<%=GetLang("LangCustAddress")%> <%=address%>
<%=GetLang("LangCustPhone")%> <%=rs("phonenumber")%>
<%=GetLang("LangCustFax")%> <%=rs("faxnumber")%>
<%=GetLang("LangCustEmail")%> <%=email%>
<%=GetLang("langmycompanyother1caption")%> <%=rs("other1")%>
<%=GetLang("langmycompanyother2caption")%> <%=rs("other2")%>
<%=GetLang("langmycompanyother3caption")%> <%=rs("other3")%>
<%=GetLang("langmycompanyother4caption")%> <%=rs("other4")%>
<% end sub '6.50 - add a random string to email form to stop bots spamming it sub CreateCAPTCHA if GetConfig("xprotectemailforms") <> "Yes" then exit sub htmlwrite "
" htmlwrite "" '702 - 2012.09.21 - Bug Fix: Fix layout issue with Recaptcha htmlwrite "

 

" htmlwrite "
" htmlwrite "*" & GetLang("langcaptchaenter") GetCAPTCHA htmlwrite "
" htmlwrite "
" htmlwrite "
" end sub %>