%option explicit%>
<%
'*****************************************************
' Version 5.00 Customer can update details
' Feb 17, 2003
'*****************************************************
dim customeradmin
Dim sAction, dbtable
Dim strPassword1, strPassword2
dim body
sAction=Request("Action")
if saction="" then
sAction=Request("Action.x")
end if
GetCustomerSessionData
dbtable="customers"
If Getsess("Customerid")="" then
Response.redirect "shopcustadminlogin.asp"
end if
If getconfig("xAllowCustomerUpdates")<>"Yes" then
Response.Redirect "shopcustadmin.asp?msg=" & Server.URLEncode ( getlang("LangCustNotAllowed"))
end if
Serror=""
If sAction = "" Then
ShopPageHeader
DisplayForm
ShopPageTrailer
Else
ValidateData()
if sError = "" Then
UpdateCustomer
WriteInfo
else
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
end if
Sub DisplayForm()
Displayerrors
response.write "
"
shopwriteheader getlang("LangMailListMailPrompt")
Response.Write("
"
' End if customer table
End Sub
Sub ValidateData
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"
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("xPromptForState")="Yes" then
If strState = "" Then
sError = sError & getlang("LangCustState") & getlang("LangCustrequired") & "
"
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
ValidateEmail
end If
If getconfig("xCountryRequired")="Yes" then
If strCountry="" or strCountry="??" then
sError = sError & getlang("LangCustCountry") & getlang("LangCustrequired") & "
"
End If
end if
ValidatePassword
CustomerGetFields ' Get additional fields
ValidateCustomerFields
End Sub
Sub WriteInfo
If Serror="" then
Response.Redirect "shopcustadmin.asp?msg=" & Server.URLEncode ( getlang("LangEdit03"))
end if
ShoppageHeader
DisplayErrors
Shoppagetrailer
End Sub
Sub DisplayErrors
if sError<> "" then
shopwriteerror SError
Serror=""
end if
end Sub
Sub UpdateCustomer
if getconfig("xMYSQL")="Yes" then
MYSQLUpdateCustomer
exit sub
end if
dim dbc, whereok, customerid
customerid=Getsess("Customerid")
dim doupdate, templastname
OpenCustomerDb dbc
Set objRS = Server.CreateObject("ADODB.Recordset")
templastname=replace(strlastname,"'","''")
sql = "select * from " & dbtable & " where contactid= " & customerid
objRS.open SQL, dbc, adOpenKeyset, adLockOptimistic, adcmdText
'debugwrite sql
If objrs.eof then
objrs.close
set objrs=nothing
shopclosedatabase dbc
Serror="Customer id not found " & customerid
exit sub
end if
updatecustfieldxxx "firstname", strfirstname
updatecustfieldxxx "lastname", strlastname
updatecustfieldxxx "address", straddress
updatecustfieldxxx "city", strcity
updatecustfieldxxx "state", strstate
updatecustfieldxxx "postcode", strpostcode
updatecustfieldxxx "country", strcountry
updatecustfieldxxx "email", stremail
updatecustfieldxxx "company", strcompany
updatecustfieldxxx "maillist", blnMailList
if getconfig("xpromptforoptional")="Yes" then
updatecustfieldxxx "phone", strphone
updatecustfieldxxx "workphone", strworkphone
updatecustfieldxxx "mobilephone", strmobilephone
updatecustfieldxxx "fax", strfax
end if
if getconfig("xpassword")="Yes" and strpassword1 <>"" then
updatecustfieldxxx "password", strpassword1
end if
if getconfig("xcustomeruserid")="Yes" and strcustuserid <>"" then
updatecustfieldxxx "userid", strcustuserid
end if
if getconfig("xcustomerotherfields")<>"" then
customerupdatefields objrs ' update additional
end if
objRS.Update
objRS.close
set objrs=nothing
ShopCloseDatabase dbc
UpdateCustomerSessiondata
end sub
'
Sub UpdateCustFieldXxx (fieldname,fieldvalue)
on error resume next
If getconfig("xdebug")="Yes" then
Debugwrite fieldname & " " & fieldvalue & "
"
end if
if fieldvalue="" then
objrs(Fieldname)=NULL
exit sub
end if
objRS(fieldname)=fieldvalue
end Sub
Sub ValidateEmail
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("LangInvalidEmail") & "
"
end if
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
end if
end if
End sub
%>