<%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("
") ShopCustomerForm If Getconfig("xbuttoncontinue")="" Then Response.Write("") else Response.Write("") end if 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 %>