<%option explicit%> <% 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 4.50 April 8, 2002 '********************************************************* 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 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 response.write "
" & getconfig("Xfont") & 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") blnMailList=request("blnMaillist") If blnMailList="" then blnMailList="False" CustomerGetFields ValidateCustomerFields ValidatePassword End Sub Sub WriteInfo ShoppageHeader If getsess("customeradmin")="" then response.write getconfig("xfont") & LangMailListinfomsg & "
" else response.write getconfig("xfont") & "Details updated " & "
" end if ShopPageTrailer End Sub Sub DisplayErrors if sError<> "" then response.write "" & getconfig("Xfont") & SError & "" Serror="" end if end Sub Sub UpdateCustomer if getconfig("xMYSQL")="Yes" then MYSQLMaillistUpdateCustomer exit sub end if dim dbc, whereok dim doupdate, templastname OpenCustomerDb dbc Set objRS = Server.CreateObject("ADODB.Recordset") templastname=replace(strlastname,"'","''") SQL = "SELECT * FROM " & dbtable & " WHERE " whereok="" sql=sql & whereok & " LastName='" & TempLastName & "'" whereok = " AND " SQL = SQL & whereok & " email='" & stremail & "'" 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 objRS("ContactReason") = MailListKey CustomerUpdateFields objrs objRS.Update strcustomerid=objrs("ContactID") CloseRecordset objrs ShopCloseDatabase dbc 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 & LangPasswordMismatch & "
" else if len(strPassword1) <6 then Serror=Serror & LangPasswordLength & "
" end if end if else sError = sError & LangCustomerPassword & LangCustRequired & "
" 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=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 %>