<%option explicit%>
<%
dim my_to, my_toaddress,my_system,my_from,my_fromaddress,my_subject,mailtype
dim mailer, my_attachment
dim customeradmin
'**********************************************************
' adds customer Contact form
' Display compnay information and allows customer to send messages
'
' Version 5.00 March 22, 2003
' Nov 19, 2003 fix closedatabase
'*********************************************************
Dim sAction, dbtable
Dim strPassword1, strPassword2
dim body, strsubject,strcomment
setsess "currenturl","shopcustcontact.asp"
If getconfig("init")="" then
dim conn
shopopendatabase conn
shopclosedatabase conn
end if
sAction=Request("Action")
if saction="" then
sAction=Request("Action.x")
end if
If getconfig("xcontactform")<>"Yes" then
' shoperror getlang("LangCustNotAllowed")
end if
Serror=""
ShopPageHeader
If sAction = "" Then
DisplayForm
Else
ValidateData()
if sError = "" Then
SendMailToMerchant strsubject
WriteInfo
else
DisplayForm
end if
end if
ShopPageTrailer
Sub DisplayForm()
Displayerrors
DisplayCompanyinfo
Response.Write(""
End Sub
Sub ValidateData
strFirstname = Request.Form("strFirstname")
strLastname = Request.Form("strLastname")
strEmail = Request.Form("strEmail")
strcomment=request("strcomment")
strsubject=request("strsubject")
strcompany=request("strcompany")
ValidateMininumInfo
End Sub
Sub WriteInfo
shopwriteheader getlang("LangTellaFriendInfo")
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")
my_from=strlastname
my_fromaddress=stremail
my_toaddress=getconfig("xemail")
my_to=getconfig("xemailname")
my_system=getconfig("xemailsystem")
my_subject=isubject
Body=""
body=body & shopdateformat(date(),getconfig("xdateformat")) & " " & time()& vbcrlf & vbcrlf
Body=Body & Strfirstname & " " & strLastname & vbcrlf
Body=body & stremail & vbcrlf
if strcompany<>"" then
Body=body & getlang("LangCustcompany") & " " & strcompany & vbcrlf
end if
body=body & vbcrlf
body=body & 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
debugwrite "Mailing to: " & my_to & "(" & my_toaddress & ") from " & strlastname & " " & stremail
end if
end sub
Sub DisplayMinimumForm
Response.Write(TableDef)
CreateCustRow getlang("LangCustFirstname"), "strfirstname", strFirstname,"Yes"
CreateCustRow getlang("LangCustLastname"), "strLastname", strLastname,"Yes"
CreateCustRow getlang("LangCustEmail"), "strEmail", strEmail, "Yes"
CreateCustRow getlang("LangSubject"), "strsubject", strSubject, "Yes"
CreateCustRow getlang("LangCustCompany"), "strcompany", strcompany, "No"
Response.Write(TableDefEnd)
Shopwriteheader getlang("LangCheckoutadditional")
Response.write "" & "
"
end sub
Sub ValidateMininumInfo
If strFirstname = "" Then
sError = sError & getlang("LangCustFirstname") & getlang("LangCustrequired") & "
"
End If
If strLastname = "" Then
sError = sError & getlang("LangCustLastname") & 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
end sub
Sub DisplaycompanyInfo
dim sql, rs, dbc, address, email, myemail
openorderdb dbc
sql="select * from mycompany"
set rs=dbc.execute(sql)
if rs.eof then
closerecordset rs
shopclosedabase dbc
exit sub
end if
Response.Write(TableDef)
'DoHeader ""
DoField getlang("LangCustCompany"),rs("companyname")
address=rs("address") & "
"
address=address & rs("city") & " " & rs("state") & " " & rs("postalcode")
address=address & "
" & rs("country")
DoField getlang("LangCustAddress"),address
DoField getlang("LangCustPhone"),rs("phonenumber")
DoField getlang("LangCustFax"),rs("faxnumber")
myemail=rs("myemail")
If not isnull(Myemail) then
email="" & myemail & ""
DoField getlang("LangCustEmail"),email
end if
response.write ""
end sub
Sub DoField (fieldname,fieldvalue)
if fieldvalue="" or isNull(fieldvalue) then
exit sub
end if
Response.write ForderFieldRow
Response.write ReportDetailColumn & fieldname & ReportDetailcolumnend
Response.write Reportdetailcolumn & fieldvalue & Reportdetailcolumnend
response.write ""
end sub
'
%>