<%option explicit%>
<%
'*****************************************************
' Version 6.50 Customer can update details
' March 26, 2004 Address 2, password
'*****************************************************
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
responseredirect "shopcustadminlogin.asp"
end if
If getconfig("xAllowCustomerUpdates")<>"Yes" then
responseredirect "shopcustadmin.asp?msg=" & Server.URLEncode ( getlang("LangCustNotAllowed"))
end if
Serror=""
If sAction = "" Then
ShopPageHeader
WriteCustUpdateHeader
DisplayForm
ShopPageTrailer
Else
ValidateData()
if sError = "" Then
UpdateCustomer
WriteInfo
else
ShopPageHeader
WriteCustUpdateHeader
DisplayForm
ShopPageTrailer
end if
end if
Sub DisplayForm()
Displayerrors
shopwriteheader getlang("LangMailListMailPrompt")
Response.Write(""
' End if customer table
End Sub
Sub ValidateData
'VP-ASP 6.50 - Precautionary Security Fix
strFirstname = cleanchars(Request.Form("strFirstname"))
strLastname = cleanchars(Request.Form("strLastname"))
strAddress = cleanchars(Request.Form("strAddress"))
strAddress2 = cleanchars(Request.Form("strAddress2"))
strCity = cleanchars(Request.Form("strCity"))
strState = cleanchars(Request.Form("strState"))
strPostCode = cleanchars(Request.Form("strPostCode"))
strCountry = cleanchars(Request.Form("strCountry"))
strCompany = cleanchars(Request.Form("strCompany"))
strWebsite = cleanchars(Request.Form("strWebsite"))
strPhone = cleanchars(Request.Form("strPhone"))
strWorkphone = cleanchars(Request.Form("strWorkphone"))
strMobilephone = cleanchars(Request.Form("strMobilephone"))
strFax = cleanchars(Request.Form("strFax"))
strHearAboutUs = cleanchars(Request.Form("hearaboutus"))
strEmail = cleanchars(Request.Form("strEmail"))
strPassword1 = cleanchars(Request.Form("strPassword1"))
strPassword2 = cleanchars(Request.Form("strPassword2"))
strcustuserid = cleanchars(Request.Form("strcustuserid"))
blnMailList=cleanchars(request("blnMaillist"))
If blnMailList="" then blnMailList="False"
blncookiequestion=cleanchars(request("blncookiequestion"))
If blncookiequestion="" then
blncookiequestion=False
else
blncookiequestion=True
end if
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
responseredirect "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
'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set
if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR 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 "address2", straddress2
updatecustfieldxxx "city", strcity
updatecustfieldxxx "state", strstate
updatecustfieldxxx "postcode", strpostcode
updatecustfieldxxx "country", strcountry
updatecustfieldxxx "email", stremail
updatecustfieldxxx "company", strcompany
updatecustfieldxxx "maillist", blnMailList
updatecustfieldxxx "cookiequestion", blncookiequestion
if getconfig("xpromptforoptional")="Yes" then
updatecustfieldxxx "phone", strphone
updatecustfieldxxx "workphone", strworkphone
updatecustfieldxxx "mobilephone", strmobilephone
updatecustfieldxxx "fax", strfax
updatecustfieldxxx "hearaboutus", strhearaboutus
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
Updatecookiedata
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
Sub AddPassword1
if getconfig("xpassword")="Yes" then
If GetSess("Login")<>"" then
response.write tabledef
Response.Write("| " & largeinfofont & getlang("langCustomerPassword") & largeinfoend & " |
")
AddPasswordForm "Yes"
response.write tabledefend
end if
end if
end sub
'************************************************************************
' Update or resrt cookie
'***********************************************************************
Sub Updatecookiedata
If getconfig("xCookieLogin")<>"Yes" then exit sub
If blnCookieQuestion then exit sub
response.cookies("CartLogin").expires=date()-2
end sub
Sub WriteCustUpdateHeader()
if getconfig("xbreadcrumbs") = "Yes" then
response.write "" & vbCrLf
End If
Response.Write "" & getlang("langcustadmindetails") & "
" & vbCrLf
End Sub
%>