<%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 to Register
' Version 5.00
' March1, 2004 Fix when using closed shops
'*********************************************************
const MailListKey="Registration"
Dim sAction, dbtable
Dim strPassword1, strPassword2
dim body
sAction=Request("Action")
if saction="" then
sAction=Request("Action.x")
end if
dbtable="customers"
If getconfig("xAllowCustomerRegister")<>"Yes" then
shoperror getlang("LangCustNotAllowed")
end if
Serror=""
If sAction = "" Then
ShopPageHeader
DisplayForm
ShopPageTrailer
Else
ValidateData()
if sError = "" Then
UpdateCustomer
SendMailToMerchant
WriteInfo
else
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
end if
Sub DisplayForm()
Displayerrors
setsess "login","" ' force customer out
shopwriteheader getlang("LangMailListMailPrompt")
Response.Write(""
' End if customer table
End Sub
Sub ValidateData
dim rc
strFirstname = Request.Form("strFirstname")
strLastname = Request.Form("strLastname")
strAddress = Request.Form("strAddress")
strCity = Request.Form("strCity")
strState = Request.Form("strState")
strPostCode = Request.Form("strPostCode")
strCountry = Request.Form("strCountry")
strCompany = Request.Form("strCompany")
strWebsite = Request.Form("strWebsite")
strPhone = Request.Form("strPhone")
strWorkphone = Request.Form("strWorkphone")
strMobilephone = Request.Form("strMobilephone")
strFax = Request.Form("strFax")
strEmail = Request.Form("strEmail")
strPassword1 = Request.Form("strPassword1")
strPassword2 = Request.Form("strPassword2")
strcustuserid = Request.Form("strcustuserid")
blnMailList=request("blnMaillist")
If blnMailList="" then blnMailList="False"
strhearaboutus=request("hearaboutus")
CustomerGetFields
ValidateCustomerFields
ValidatePassword
ValidateUsername strcustuserid, serror, rc
End Sub
Sub WriteInfo
ShoppageHeader
If getsess("customeradmin")="" then
shopwriteheader getlang("LangMailListinfomsg")
else
shopwriteheader getlang("LangEdit03")
end if
ShopPageTrailer
End Sub
Sub DisplayErrors
if sError<> "" then
shopwriteError SError
Serror=""
end if
end Sub
Sub UpdateCustomer
if getconfig("xMYSQL")="Yes" then
MYSQLMaillistUpdateCustomer
exit sub
end if
dim dbc, whereok
dim doupdate, templastname, tempemail
SetSess "Login","Force"
OpenCustomerDb dbc
Set objRS = Server.CreateObject("ADODB.Recordset")
templastname=replace(strlastname,"'","''")
tempemail=replace(stremail,"'","''")
SQL = "SELECT * FROM " & dbtable & " WHERE "
whereok=""
sql=sql & whereok & " lastname='" & templastname & "'"
whereok = " AND "
SQL = SQL & whereok & " email='" & tempemail & "'"
objRS.open SQL, dbc, adOpenKeyset, adLockOptimistic, adcmdText
if not ObjRS.eof then
DoUpdate="True"
else
objRs.close
set objRS=nothing
end if
If Doupdate="" then
Set objRS = Server.CreateObject("ADODB.Recordset")
objRS.open dbtable, dbc, adOpenKeyset, adLockOptimistic, adCmdTable
objRS.AddNew
end if
objrs("firstname") = strfirstname
objrs("lastname") = strlastname
objrs("address") = straddress
objrs("city") = strcity
objrs("state") = strstate
objrs("postcode") = strpostcode
objrs("country") = strcountry
objrs("company") = strcompany
objrs("phone") = strphone
' objrs("workphone") = strworkphone
' objrs("mobilephone") = strmobilephone
objrs("fax") = strfax
objrs("email") = stremail
objrs("maillist")=blnmaillist
updatecustfieldxxx "password", strpassword1
updatecustfieldxxx "userid", strcustuserid
updatecustfieldxxx "hearaboutus", strhearaboutus
objrs("contactreason") = maillistkey
CustomerUpdateFields objrs
objRS.Update
strcustomerid=objrs("contactid")
CloseRecordset objrs
ShopCloseDatabase dbc
SetSess "Login",""
SetSess "customerid", strCustomerID
end sub
'
Sub UpdateCustFieldXxx (fieldname,fieldvalue)
on error resume next
if fieldvalue="" then
exit sub
end if
If getconfig("xdebug")="Yes" then
Debugwrite fieldname & " " & fieldvalue & " "
end if
objRS(fieldname)=fieldvalue
end Sub
Sub ValidatePassword
Dim rc
if ucase(getconfig("xpassword"))="YES" then
if strPassword1<>"" then
If StrPassword1<>strPassword2 then
SError= SError & getlang("LangPasswordMismatch") & " "
else
if len(strPassword1) <6 then
Serror=Serror & getlang("LangPasswordLength") & " "
end if
end if
else
sError = sError & getlang("LangCustomerPassword") & getlang("LangCustrequired") & " "
End if
If getconfig("xcustomeruserid")="Yes" then
If strcustuserid = "" Then
sError = sError & getlang("LangAdminusername") & getlang("LangCustrequired") & " "
End If
end if
end if
End sub
Sub SendMailToMerchant
dim acount
If getconfig("XMailListToMerchant")<>"Yes" then exit sub
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= getlang("LangMailListRegistration") & " (" & strcustomerid & ")"
Body=my_subject & vbcrlf
body=body & shopdateformat(date(),getconfig("xdateformat")) & " " & time()& vbcrlf
Body=Body & Strfirstname & " " & strLastname & vbcrlf
body=body & strAddress & vbcrlf
body=body & strCity & " " & strState & " " & strpostcode & vbcrlf
body=body & strCountry & vbcrlf
Body=body & strPhone & vbcrlf
Body=body & stremail & vbcrlf
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
%>