<%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 5.00 April 5, 2003
'*********************************************************
const MailListKey="Registration"
Dim sAction, dbtable
Dim strPassword1, strPassword2
dim body
If getconfig("init")="" then
dim conn
shopopendatabase conn
shopclosedatabase conn
end if
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
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
updatecustfieldxxx "userid", strcustuserid
updatecustfieldxxx "hearaboutus", strhearaboutus
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 & 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
%>