<%option explicit%>
<%
'*******************************************************
' Version 6.50
' If everyone must login then make them login
' March 26, 2004
' Oct 10, 2004 do close recordset line 224
'*******************************************************
Dim strPassword1
Dim strPassword2
Dim msg, newcust
Dim i
Dim sAction
dim rs
' the database can be used. If you don't display form
Dim dbc
' **********************************************************************
' Set defaults here
'**********************************************************************
SetSess "CurrentURL","shoploginforce.asp"
SetSess "FollowonURL","shopdisplaycategories.asp"
'
sAction=Request.form("Action") ' find out if we are being called via submit
If saction="" then
sAction=Request.form("Action.x") ' find out if we are being called via submit
end if
Serror=GetSess("Loginerror") ' possible mesage from login
SEtSess "Loginerror","" ' error from shop login
If sAction = "" Then ' no came from customer logic
GetCustomerSessionData
DisplayEverything
Else
sError=""
ValidateData() ' need to validate anything, nothing is required
if sError = "" Then
UpdateOrderInformation ' put in customer and order data
'VP-ASP 6.50 - when customer registers, they should be logged in as well
if getconfig("xcustomerrequiresauthorization") = "Yes" then
SEtSess "Login",""
SEtSess "CustomerID",""
SEtSess "Lastname",""
shoperror getlang("langauthnotdone")
else
SetSess "Login",strlastname
end if
ResponseRedirect GetSess( "FollowonURL")
else
DisplayEverything
end if
end if
Sub DisplayEveryThing
ShopPageHeader ' Normal page header
Displayerrors ' any input errors
DisplayLoginForm() ' display customer
ShopPageTrailer ' Normal page trailer
end Sub
' adds to customer table, order table, oitems table
Sub UpdateOrderInformation
UpdateContact ' add customer to database
strCustomerid=GetSess("Customerid")
strDiscount=GetSess("CustDiscount")
UpdateCustomerSessionData
End Sub
Sub DisplayLoginForm()
AddLogin ' User login form
If getconfig("xRestrictedtoExisting")= "Yes" then exit sub
' Outside table
Response.Write("")
End Sub
Sub ValidateData()
'VP-ASP 6.50 - security fix
strFirstname = cleanchars(Request.Form("strFirstname"))
strLastname = cleanchars(Request.Form("strLastname"))
strAddress = cleanchars(Request.Form("strAddress"))
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"))
strEmail = cleanchars(Request.Form("strEmail"))
strPassword1 = cleanchars(Request.Form("strPassword1"))
strPassword2 = cleanchars(Request.Form("strPassword2"))
strcustuserid = cleanchars(Request.Form("strcustuserid"))
strhearaboutus = cleanchars(Request.Form("hearaboutus"))
CustomerGetFields
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("xPromptForState")="Yes" then
If strState = "" or 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
CustomerValidateEmail stremail
end if
if getconfig("xCountryRequired")="Yes" then
If strCountry="" or strCountry="??" then
sError = sError & getlang("LangCustCountry") &getlang("LangCustRequired")& " "
End If
end if
If strhearaboutus=getlang("langcommonselect") then
strhearaboutus=""
end if
If getconfig("xhearaboutusrequired")="Yes" and strhearaboutus="" then
sError = sError & getlang("langhearaboutus") & getlang("langCustRequired") & " "
end if
ValidatePassword
dim rc
If serror="" then
CheckForDuplicateReg rc
end if
end sub
Sub AddLogin
If GetSess("Login")<>"" then
exit sub
end if
'shopwriteheader getlang("LangCust01")
ShoploginForceform
end sub
Sub AddOptionalStuff
If getconfig("xPromptForOptional")="Yes" then
Response.Write(" " & getlang("LangCust02") & "")
Response.Write(TableDef)
CreateCustRow getlang("LangCustWebsite"), "strwebsite", strwebsite,"No"
CreateCustRow getlang("LangCustWorkphone"), "strWorkphone", strWorkPhone, "No"
CreateCustRow getlang("LangCustMobilephone"), "strMobilephone", strMobilePhone, "No"
CreateCustRow getlang("LangCustFax"), "strFax", strFax, "No"
Response.Write("
")
end if
end sub
Sub ValidatePassword
Dim rc
if ucase(getconfig("xpassword"))="YES" then
If getconfig("xcustomeruserid")="Yes" then
If strcustuserid = "" Then
sError = sError & getlang("LangAdminusername") &getlang("LangCustRequired")& " "
End If
end if
If strPassword1 = "" Then
sError = sError & getlang("LangPassword") & "1" &getlang("LangCustRequired")& " "
exit sub
End If
If strPassword2 = "" Then
sError = sError & getlang("LangPassword") & "2" &getlang("LangCustRequired")& " "
exit sub
End If
If StrPassword1<>strPassword2 then
SError= SError & getlang("LangPasswordMismatch") & " "
exit sub
end if
if len(strPassword1) >= 6 then
CheckForDuplicate rc
if rc > 0 then
SError= SError & getlang("LangPasswordDuplicate") & " "
end if
else
Serror=Serror & getlang("LangPasswordLength") & " "
end if
end if
End sub
Sub DisplayErrors
if sError<> "" then
shopwriteError SError
Serror=""
end if
end Sub
Sub AddSubmitButton
If Getconfig("xbuttoncontinue")="" then
Response.Write("")
else
Response.Write("")
end if
end sub
Sub CheckForDuplicate (rc)
Dim testsql
dim myconn
SetSess "Login","Force"
OpenCustomerDb myconn
'VP-ASP 6.09 - clean insecure characters from email
sql = "select * from customers where lastname='" & strlastname & "' and password ='" & strpassword1 & "'"
sql = sql & " and email='" & cleanchars(stremail) & "'"
'debugwrite sql
Set rs = myconn.Execute(SQL)
If Not rs.EOF Then
rc=4
else
rc=0
end if
closerecordset rs
shopclosedatabase myconn
SetSess "Login",""
end sub
Sub addInformationTable
response.write "
"
end Sub
Sub ValidateEmail
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("LangInvalidEmail") & " "
end if
End sub
Sub CheckForDuplicateReg (rc)
If getconfig("xCheckexistingcustomer")<>"Yes" Then exit sub
Dim testsql
dim myconn
dim temail, tname, tpassword1
tname=replace(strlastname,"'","''")
temail=replace(stremail,"'","''")
'VP-ASP 6.09 - Remove any insecure characters from input
tname=cleanchars(tname)
temail=cleanchars(temail)
SetSess "Login","Force"
OpenCustomerDb myconn
sql = "select * from customers where lastname='" & tname & "' "
sql = sql & " and email='" & temail & "'"
'debugwrite sql
Set rs = myconn.Execute(SQL)
If Not rs.EOF Then
rc=4
sError = sError & getlang("langCustomerExists") & " "
else
rc=0
end if
closerecordset rs
shopclosedatabase myconn
SetSess "Login",""
end sub
Sub ShopLOginForceForm
Dim caption
If getconfig("xcustomeruserid")="Yes" then
caption=getlang("langAdminUsername")
else
caption=getlang("langStatusEmail")
end if
%>
