<%option explicit%>
[an error occurred while processing this directive]
<%
If getconfig("xIncludeCountries")="Yes" Then
%>
<%
' VP-ASP 5.0 Nov 4, 2003
Sub ShopCountries(formname, fieldname)
%>
<%
end sub
%>
<%
End if
If getconfig("xIncludeStates")="Yes" Then
%>
<%
Sub ShopStates (formname,fieldname)
%>
<%
end sub
%>
<%
End if
If getconfig("xvatnumber")="Yes" Then
%>
<%
'*********************************************************
' VP-ASP 5.00 Validate vatnumber
' Feb 4, 2003
'*********************************************************
Sub Validatevat (strcountry)
dim vatmycountry, partial
setsess "vatnumber",""
dim vatnumber, vatrc
vatnumber=request("vatnumber")
If vatnumber <> "" then
ShopvalidateVat strcountry, vatnumber, vatrc
select case vatrc
case 0
vatmycountry=getconfig("xvatcountry")
if strcountry<>vatmycountry then
setsess "vatnumber",vatnumber
end if
case 4
sError = sError & getlang("LangVatinvalid") & " " & vatnumber & " "
end select
end if
End sub
'*********************************************************
' VP-ASP 4.50 April 7, 2002
' Validate VAT
'******************************************************
Sub ShopValidateVat(country, vatnumber, rc)
dim tmpcountry, tmpvat, partial
tmpvat = ucase(replace(vatnumber," ", ""))
tmpcountry = left(vatnumber,2)
If tmpcountry=country then
tmpvat=right(tmpvat, len(vatnumber) - 2)
end if
select case country
case "AT"
if len(tmpvat) = 9 then
if left(tmpvat, 1) = "U" then
rc = 0
else
rc = 4
end if
else
rc = 4
end if
case "BE"
if len(tmpvat) = 9 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "DK"
if len(tmpvat) = 8 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "FI"
if len(tmpvat) = 8 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "FR"
rc=4
if len(tmpvat) <> 11 then exit sub
partial=mid(tmpvat,3,9)
If not isnumeric(partial) then exit sub
rc=0
case "UK"
if len(tmpvat) = 9 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "DE"
if len(tmpvat) = 9 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "EL"
if len(tmpvat) = 9 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "IE"
if len(tmpvat) = 9 and not isnumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "IT"
if len(tmpvat) = 11 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "LU"
if len(tmpvat) = 8 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "NL"
if len(tmpvat) = 12 And left(right(tmpvat, 3), 1) = "B" And IsNumeric(right(tmpvat,2)) then
rc = 0
else
rc = 4
end if
case "PT"
if len(tmpvat) = 9 And IsNumeric(tmpvat) then
rc = 0
else
rc = 4
end if
case "ES"
if len(tmpvat) = 9 And IsNumeric(left(right(tmpvat, 8),7)) then
rc = 0
else
rc = 4
end if
case "SE"
if len(tmpvat) = 12 And IsNumeric(tmpvat) And right(tmpvat, 2) = "01" then
rc = 0
else
rc = 4
end if
case else
'Set country to "" and return invalid country code error
rc=8
end select
end sub
%>
<%
End if
Sub ShopCustomerForm
'*******************************************************************
' Customer form used in many places
' CreateCustRow is in shop$colors.asp
' Version 5.00 June 16, 2003
' ShippingOtherfields
' Exclude fields
'********************************************************************
Response.Write(TableDef)
CreateCustRow getlang("langCustFirstname"), "strfirstname", strFirstname,"Yes"
CreateCustRow getlang("langCustLastname"), "strLastname", strLastname,"Yes"
CreateCustRow getlang("langCustAddress"), "strAddress", strAddress,"Yes"
CreateCustRow getlang("langCustCity"), "strCity", strCity,"Yes"
If getconfig("xPromptForState")="Yes" then
If getconfig("xIncludeStates")="Yes" Then
Response.Write(tableRow & tablecolumn & "* " & getlang("langCustState") & tablecolumnend & "
")
else
CreateCustRow getlang("langCustState"), "strState", strState,"Yes"
end if
end if
CreateCustRow getlang("langCustPostCode"), "StrPostcode", strPostCode,"Yes"
CreateCustRow getlang("langCustPhone"),"strPhone", strPhone, "Yes"
CreateCustRow getlang("langCustEmail"), "strEmail", strEmail, "Yes"
If getconfig("xPromptForCountry")="Yes" then
if strcountry="" and getconfig("xdefaultcountry")<>"" then
strcountry=getconfig("xdefaultcountry")
end if
If getconfig("xIncludeCountries")="Yes" Then
If getconfig("xCountryRequired")="Yes" then
Response.Write(tableRow & tablecolumn & "* " & getlang("langCustCountry") & tablecolumnend & "
")
End if
ShopCountries "StrCountry", strCountry
Response.Write("
")
else
If getconfig("xCountryRequired")="Yes" then
CreateCustRow getlang("langCustCountry"), "strCountry", strCountry,"Yes"
Else
CreateCustRow getlang("langCustCountry"), "strCountry", strCountry,"No"
End if
end if
end if
CreateCustRow getlang("langCustCompany"), "strCompany", strCompany,"No"
If getconfig("xvatnumber")="Yes" then
CreateCustRow getlang("langVatnumber"),"vatnumber", strvatnumber,"No"
end if
AddOtherFields
AddPassword
Response.Write(TableDefEnd)
AddCookieMessage
AddMaillIst
AddHowDidYouHear
end sub
'
Sub AddPassword
if getconfig("xpassword")="Yes" then
If GetSess("Login")="" then
Response.Write("
")
AddPasswordForm "Yes"
end if
end if
end sub
Sub AddPasswordForm (yesno)
If Getconfig("Xcustomeruserid")="Yes" then
CreateCustRow getlang("langadminusername"), "strcustuserid", strcustuserid,Yesno
end if
CreateCustRowP getlang("langPassword"), "strpassword1", strpassword1,Yesno
CreateCustRowP getlang("langPassword"), "strpassword2", strpassword2,Yesno
end sub
Sub ShopShippingForm
'on error resume next
Response.Write(TableDef)
If getconfig("xShippingDatabaseRecords")="Yes" then
If GetSess("Shipmethodtype")="" and getconfig("xDefaultShippingMethod")<>"Yes" then
shipmethodtype=getlang("langCommonSelect")
end if
Response.Write(tableRow & tablecolumn & "* " & getlang("langShippingMethod") & tablecolumnend & "
")
else
CreateCustRow getlang("langCustState"),"shipstate",strshipstate,"No"
end if
end if
CreateCustRow getlang("langCustPostCode"),"shipzip", strshipzip,"No"
If getconfig("xPromptForCountry")="Yes" then
If getconfig("xIncludeCountries")="Yes" Then
Response.Write(tableRow & tablecolumn & getlang("langCustCountry") & tablecolumnend & "
")
else
CreateCustRow getlang("langCustCountry"), "shipcountry", strshipCountry,"No"
end if
end if
CreateCustRow getlang("langCustCompany"), "shipcompany", strshipcompany,"No"
ShippingAddOtherFields
Response.Write(TableDefEnd)
' end if shipping table
end sub
Sub AddMailList
If getconfig("XmailListCheckBox")<>"Yes" then exit sub
Response.Write(TableDef)
Response.Write tablerow
Response.write TableColumn
Response.write getlang("langCustAdminMailList")
Response.write TableColumnEnd
Response.write TableColumn
If blnmaillist="" then
blnmaillist=TRUE
end if
If blnmaillist then%>
<%Else%>
<%
End if
response.write tablecolumnend & tablerowend & tabledefend
end Sub
Sub AddOtherFields
dim words,wordcount, captions, capcount,customervalues,i
dim exludefields, excludecount, rc
redim words(Getconfig("xCustomerMaxotherfields"))
redim captions(getconfig("xCustomerMaxotherfields"))
redim excludefields(getconfig("xCustomerMaxotherfields"))
if Getconfig("xCustomerOtherFields")<>"" then
Customervalues=Getsess("Customervalues")
Parserecord Getconfig("xcustomerOtherFields"), words, wordcount,","
Parserecord getconfig("xcustomerOtherCaptions"), captions, capcount,","
If getconfig("xcustomerotherbypass")<>"" then
Parserecord getconfig("xcustomerOtherbypass"), excludefields, excludecount,","
else
excludecount=0
end if
for i = 0 to wordcount-1
if excludecount> 0 then
CustomerExcludetest words(i), excludefields, excludecount, rc
else
rc=0
end if
if rc=0 then
If isarray(customervalues) then
CreateCustRow captions(i),words(i), customervalues(i),"No"
else
CreateCustRow captions(i),words(i), "","No"
end if
end if
next
end if
end sub
'
Sub CustomerGetFields
dim words,wordcount,customervalues,i, customerfieldcount
dim required, requiredcount, testfield, j
if getconfig("xCustomerOtherFields")="" then exit sub
redim words(Getconfig("xCustomerMaxotherfields"))
redim Required(getconfig("xCustomerMaxotherfields"))
Customervalues=Getsess("Customervalues")
CustomerFieldcount=Getsess("CustomerFieldcount")
Parserecord getconfig("xcustomerOtherFields"), words, wordcount,","
If getconfig("xCustomerOtherrequired")<>"" then
Parserecord getconfig("xcustomerOtherRequired"), required, requiredcount,","
else
requiredcount=0
end if
If not isarray(customervalues) then
redim customervalues(wordcount)
SetSess "customerFieldcount",wordcount
customerfieldcount=wordcount
end if
for i = 0 to wordcount-1
customervalues(i)=request(words(i))
next
SetSess "Customervalues",customervalues
SetSess "customerFieldcount",wordcount
If requiredcount=0 then exit sub
for i = 0 to requiredcount-1
testfield=ucase(required(i))
for j=0 to wordcount-1
if testfield=ucase(words(j)) then
If customervalues(j)="" Then
sError = sError & words(j) & getlang("langCustRequired") & " "
end if
exit for
end if
next
next
End sub
Sub AddCookieMessage
If getconfig("XCookielogin")<>"Yes" then exit sub
Response.Write(TableDef)
Response.Write tablerow
Response.write TableColumn
Response.write getlang("langCookieQuestion")
Response.write TableColumnEnd
Response.write TableColumn
If blncookiequestion="" then
blncookiequestion=TRUE
end if
If blncookiequestion then%>
<%Else%>
<%
End if
response.write tablecolumnend & tablerowend & tabledefend
end Sub
Sub ValidateCustomerFields
If strFirstname = "" Then
sError = sError & getlang("langCustFirstname") & getlang("langCustRequired") & " "
End If
If strLastname = "" Then
sError = sError & getlang("langCustLastname") & getlang("langCustRequired") & " "
End If
If strAddress = "" Then
sError = sError & getlang("langCustAddress") & getlang("langCustRequired") & " "
End If
If strCity = "" Then
sError = sError & getlang("langCustCity") & getlang("langCustRequired") & " "
End If
If getconfig("xIncludeStates")="Yes" and strState="??" then
strstate=""
end if
If getconfig("xstaterequired")="Yes" then
If getconfig("xPromptForState")="Yes" then
If strState = "" Then
sError = sError & getlang("langCustState") & getlang("langCustRequired") & " "
End If
end if
end if
If strPostCode = "" Then
sError = sError & getlang("langCustPostCode") & getlang("langCustRequired") & " "
End If
If strPhone = "" Then
sError = sError & getlang("langCustPhone") & getlang("langCustRequired") & " "
End If
If strEmail = "" Then
sError = sError & getlang("langCustEmail") & getlang("langCustRequired") & " "
Else
CustomerValidateEmail stremail
end If
If getconfig("xCountryRequired")="Yes" then
If strCountry="" or strCountry="??" then
sError = sError & getlang("langCustCountry") & getlang("langCustRequired") & " "
End If
end if
If getconfig("xvatnumber")="Yes" then
validatevat strcountry
end if
If strhearaboutus=getlang("langcommonselect") then
strhearaboutus=""
end if
If getconfig("xhearaboutusrequired")="Yes" and strhearaboutus="" then
sError = sError & getlang("langhearaboutus") & getlang("langCustRequired") & " "
end if
end sub
'
Sub CustomerValidateEmail (stremail)
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("langInvalidEmail") & " "
end if
End sub
Sub ShippingAddOtherFields
dim words,wordcount, captions, capcount,customervalues,i
redim words(Getconfig("xCustomerMaxotherfields"))
redim captions(getconfig("xCustomerMaxotherfields"))
if Getconfig("xShippingOtherFields")<>"" then
Customervalues=Getsess("Shippingvalues")
Parserecord Getconfig("xShippingOtherFields"), words, wordcount,","
Parserecord getconfig("xShippingOtherCaptions"), captions, capcount,","
for i = 0 to wordcount-1
If isarray(customervalues) then
CreateCustRow captions(i),words(i), customervalues(i),"No"
else
CreateCustRow captions(i),words(i), "","No"
end if
next
end if
end sub
Sub ShippingGetOtherFields
dim words,wordcount,shippingvalues,i, shippingfieldcount
dim required, requiredcount, testfield, j
if getconfig("xshippingOtherFields")="" then exit sub
redim words(Getconfig("xCustomerMaxotherfields"))
redim Required(getconfig("xcustomerMaxotherfields"))
shippingvalues=Getsess("shippingvalues")
shippingFieldcount=Getsess("shippingFieldcount")
Parserecord getconfig("xshippingOtherFields"), words, wordcount,","
If getconfig("xshippingOtherrequired")<>"" then
Parserecord getconfig("xshippingOtherRequired"), required, requiredcount,","
else
requiredcount=0
end if
If not isarray(shippingvalues) then
redim shippingvalues(wordcount)
SetSess "shippingFieldcount",wordcount
shippingfieldcount=wordcount
end if
for i = 0 to wordcount-1
shippingvalues(i)=request(words(i))
next
SetSess "shippingvalues",shippingvalues
SetSess "shippingFieldcount",wordcount
If requiredcount=0 then exit sub
for i = 0 to requiredcount-1
testfield=ucase(required(i))
for j=0 to wordcount-1
if testfield=ucase(words(j)) then
If shippingvalues(j)="" Then
sError = sError & words(j) & getlang("langCustRequired") & " "
end if
exit for
end if
next
next
End sub
'*********************************************************************
' see if customerid alread exists by userid
'********************************************************************
Sub ValidateUsername (strcustuserid, serror, rc)
dim conn, sql, rs
If serror<>"" then exit sub
If getconfig("xcustomeruserid")<>"Yes" then exit sub
Opencustomerdb conn
sql="select * from customers where userid='" & replace(strcustuserid,"'","") & "'"
set rs=conn.execute(sql)
if not rs.eof then
rc=4
sError = sError & getlang("langCustomerExists") & " "
end if
closerecordset rs
shopclosedatabase conn
end sub
'******************************************************************************
' Use xhowdidyourhear and values'
'****************************************************************************
Sub AddHowDidYouHear
dim words(50), wordcount, hearvalues
If getconfig("xhearaboutus")<>"Yes" then exit sub
hearvalues=getconfig("xhearaboutusvalues")
if hearvalues="" then exit sub
parserecord hearvalues,words,wordcount,","
Response.Write TableDef & tablerow & TableColumn
Response.write getlang("langHearaboutus")
Response.write TableColumnEnd & tablerowend
Response.Write tablerow & TableColumn
response.write "
"
response.write tablecolumnend & tablerowend & tabledefend
end Sub
Sub CustomerExcludetest (fieldname, excludefields, excludecount, rc)
dim i, lfieldname
lfieldname=lcase(fieldname)
for i = 0 to excludecount-1
if lfieldname=lcase(excludefields(i)) then
rc=4
exit sub
end if
next
rc=0
end sub
%>
<%
sub ExecuteMail(mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,Orderattachments, Orderattachmentcount)
'*****************************************************************************
' Version 5.00
' CDONTS, ASPMAIL, JMAIL, ASPEMAIL,OCXMAIL, CDOSYS, DUNDAS
' April 3, 2003 MYSQL
'*****************************************************************************
dim mailer
dim mailerror
dim htmlformat
dim i
'my_system=getconfig("xemailsystem")
htmlformat=ucase(emailformat)
on error resume next
If getconfig("xdebug")="Yes" then
Debugwrite "to=" & my_to & "(" & my_toaddress &") from=" & my_from &"("& my_fromaddress &")"
debugwrite "attachments=" & orderattachmentcount
debugwrite body
end if
If ucase(mailtype)="CDONTS" Then
Set Mailer = Server.CreateObject("CDONTS.NewMail")
if err.number<> 0 then
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
exit sub
end if
Mailer.To = my_toaddress
Mailer.From = my_from & " <" & my_fromaddress & ">"
Mailer.Subject = my_subject
Mailer.Body = body
If htmlformat="HTML" then
Mailer.BodyFormat = 0
Mailer.MailFormat = 0
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AttachFile orderattachments(i)
If getconfig("xdebug")="Yes" then
Debugwrite "adding " & orderattachments(i)
end if
next
Orderattachmentcount=0
end if
Mailer.Send
set mailer=nothing
exit sub
end if
if ucase(mailtype)="ASPMAIL" then
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
' response.write "mail error " & err.number
if err.number<> 0 then
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
exit sub
end if
Mailer.AddRecipient my_to, my_toaddress
Mailer.RemoteHost = my_system
Mailer.FromName = my_from
Mailer.FromAddress = my_fromAddress
Mailer.Subject = my_subject
Mailer.BodyText=body
If htmlformat="HTML" then
Mailer.ContentType = "text/html"
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AddAttachment orderattachments(i)
next
end if
If Mailer.SendMail then
set Mailer=nothing
exit sub
else
mailerror= getlang("langmailerror") & " " & my_toaddress
mailerror=mailerror & " " & mailer.response
HandleMailError mailerror
Set mailer=nothing
exit sub
end if
end if
If ucase(Mailtype) = "JMAIL" Then
Set Mailer = Server.CreateObject("JMail.SMTPMail")
if err.number<> 0 then
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
exit sub
end if
Mailer.ServerAddress = my_system
Mailer.Sender = my_fromAddress
Mailer.SenderName = my_from
Mailer.AddRecipient my_toaddress
Mailer.Subject = my_subject
If htmlformat="HTML" then
Mailer.ContentType = "text/html"
end if
Mailer.Body = body
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AddAttachment orderattachments(i)
next
end if
If Mailer.execute then
set Mailer=nothing
exit sub
else
mailerror= getlang("langmailerror") & " " & my_toaddress
HandleMailError mailerror
set mailer=nothing
exit sub
end if
end if
If ucase(Mailtype) = "ASPEMAIL" Then
Set Mailer = Server.CreateObject("Persits.MailSender")
if err.number<> 0 then
exit sub
end if
Mailer.Host = my_system
Mailer.From = my_fromAddress
Mailer.FromName = my_from
Mailer.AddAddress my_toaddress, my_to
Mailer.Subject = my_subject
If htmlformat="HTML" then
Mailer.IsHTML = TRUE
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
Mailer.AddAttachment orderattachments(i)
next
end if
Mailer.Body = body
If Mailer.Send then
set Mailer=nothing
exit sub
else
mailerror= getlang("langmailerror") & " " & my_toaddress
HandleMailError mailerror
set mailer=nothing
exit sub
end if
end if
If ucase(Mailtype) = "OCXMAIL" Then
Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1")
If htmlformat="HTML" then
dim result
result=Mailer.XHeader ("Content-Type", "text/html")
end if
mailerror = mailer.SendMail(my_system, my_toaddress, my_fromaddress, my_subject, body)
If "" = mailerror Then
Set mailer=nothing
exit sub
Else
mailerror= getlang("langmailerror") & " " & my_toaddress & VbCR & mailerror
HandleMailError mailerror
set mailer=nothing
End If
exit sub
End IF
If ucase(Mailtype) = "DUNDAS" Then
Set mailer = Server.CreateObject("Dundas.Mailer") 'Mailer object
mailer.TOs.Add my_toaddress, my_to
mailer.Subject = my_subject
mailer.SMTPRelayServers.Add my_system
mailer.FromAddress = my_fromaddress
mailer.Fromname = my_from
If htmlformat="HTML" then
Mailer.HTMLBody = body
else
mailer.Body = body
end if
If Orderattachmentcount>0 then
for i = 0 to orderattachmentcount-1
mailer.Attachments.Add orderattachments(i)
next
end if
mailer.SendMail
'test for success/failure of the SendMail operation using VBScript's Err object
If Err.Number <> 0 Then
'an error occurred so output the relevant error string
mailerror= getlang("langmailerror") & " " & my_toaddress & " The following error occurred: " & Err.Description
HandleMailError mailerror
End if
Set mailer = Nothing 'release resources
exit sub
End If
'
mailerror= getlang("langmailerror") & " " & mailtype
HandleMailError mailerror
end sub
Sub HandleMailerror (errormsg)
SetSess "mailerror",errormsg
If getconfig("xDebug")="Yes" then
debugwrite errormsg
end if
end sub
%>
<%
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"
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
'
%>