<%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="" '800 - 2015.08.17 - Better handling on the site title '2019.04.29 - Enhancement: To include options to generate meta title to the site dim temp_meta_site_title temp_meta_site_title = GetLang("langcontactus") include_xtitle_process temp_meta_site_title SetSess "Dynamictitle", temp_meta_site_title ShopPageHeader '6.09 - added breadcrumb / VP-ASP 6.50 - added config option to turn breadcrumb on/off if GetConfig("xbreadcrumbs") = "Yes" then response.write "" end if htmlwrite "

" if sAction = "" then DisplayForm else '2023.05.19 - Enhancement: Captcha: Add in honeypot to prevent bot spams verifygenpredefinedsecuritycode_checkout request.form("genpredefinedsecuritycode") ValidateData() if SError = "" then SendMailToMerchant strsubject WriteInfo DisplayCompanyInfo else DisplayForm end if end if htmlwrite "

" ShopPageTrailer ShopCloseDatabase dbc sub DisplayForm() htmlwrite "

" htmlwrite "

" DisplayMinimumForm htmlwrite "

" htmlwrite "

" DisplayCompanyInfo Displaygooglemap htmlwrite "

" htmlwrite "

" 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 '800 - 2015.05.07 - Bug Fix: Layout issue: shopcustcontact.asp layout unformattd after sent sub WriteInfo %>

<%=GetLang("langcontactus")%>

<%=GetLang("LangTellaFriendInfo")%>

<%=GetLang("langyourname")%>

<%=strFirstname%>

<%=GetLang("langloginemail")%>

<%=strEmail%>

<%=GetLang("langsubject")%>

<%=strSubject%>

<%=GetLang("langmenucomment")%>

<%=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,"""","""""") 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 '800 - 2015.04.22 - Responsive Layout updated %>

<%=GetLang("langcontactus")%>

<%DisplayErrors%> <%'2023.05.19 - Enhancement: Contact us page: Much better in handling spam%>

" autocomplete="off"> <% '2023.05.19 - Enhancement: Captcha: Add in honeypot to prevent bot spams 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","" CreateCAPTCHA 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 '2020.11.30 - Enhancement: Email: Do not process send email to merchant if match with senstive words if trim(strComment) <> "" then if is_comment_sentive_pass(strcomment) then SError = SError & GetLang("langsomethingwentwrong") end if end if '800 - 2018.02.26 - Enhancement: Included Google Recaptcha V2 verify_captcha_process SError end sub sub DisplayCompanyInfo dim sql, rs, address, email, myemail sql="select * from mycompany" '800 - 2016.09.06 - Company info: Multiple sites can have unique company information if lcase(getconfig("xsite_sharecompany")) = "no" then sql = sql & " where (xshopid is null or xshopid = '' or xshopid = '"& tosql(xshopid,"Text") &"')" end if Set rs = Server.CreateObject("ADODB.Recordset") '800 - 2016.09.06 - Company info: Better database handling rs.open sql, dbc, adOpenKeyset, adLockReadOnly 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")%>

<%=GetLang("LangCustCompany")%>

<%=rs("companyname")%>

<%=GetLang("LangCustAddress")%>

<%=address%>

<%=GetLang("LangCustPhone")%>

<%=rs("phonenumber")%>

<%=GetLang("LangCustFax")%>

<%=rs("faxnumber")%>

<% myemail=rs("myemail") If not isnull(Myemail) then email="" & myemail & "" %>

<%=GetLang("LangCustEmail")%>

<%=email%>

<% end if %> <%'700 - 2010.09.09 - Enhancement: To include mycompany table spare fields%> <%If not isnull(rs("other1")) then%> <%If trim(rs("other1")) <> "" then%>

<%=GetLang("langmycompanyother1caption")%>

<%=rs("other1")%>

<%end if%> <%end if%> <%If not isnull(rs("other2")) then%> <%If trim(rs("other2")) <> "" then%>

<%=GetLang("langmycompanyother2caption")%>

<%=rs("other2")%>

<%end if%> <%end if%> <%If not isnull(rs("other3")) then%> <%If trim(rs("other3")) <> "" then%>

<%=GetLang("langmycompanyother3caption")%>

<%=rs("other3")%>

<%end if%> <%end if%> <%If not isnull(rs("other4")) then%> <%If trim(rs("other4")) <> "" then%>

<%=GetLang("langmycompanyother4caption")%>

<%=rs("other4")%>

<%end if%> <%end if%>

<% CloseRecordSet rs end sub '6.50 - add a random string to email form to stop bots spamming it sub CreateCAPTCHA_old end sub %>