<%option explicit%>
<%
'*********************************************************
' Display customer, shipping forms form is now in shopcustomerform.asp
' Version 4.00 November 27,2001, 2001
'*********************************************************
Dim strPassword1, strPassword2, ShipMethodType
Dim msg, newcust, strcoupon, Restorefromcookie
Dim i, sAction, Oid, dbc, scartitem, arrCart, Length
dim cookielogin
' Main Logic
SetupCustomer
If request("new")<>"" then
ResetCustomerSessionData
Setsess "customerlogincid",""
SetSess "Login",""
setsess "lastname",""
cookielogin="No"
end if
'
sAction=Request.form("Action") ' find out if we are being called via submit
if saction="" then
sAction=Request.form("Action.x")
end if
Serror=GetSess("Loginerror") ' possible mesage from login
SetSess "Loginerror","" ' error from shop login
If sAction = "" Then ' no came from customer logic
If cookielogin<>"No" then
Getcustomercookie
end if
Cookielogin=""
GetGiftRegSessionData
GetCustomerSessionData '
DisplayEverything '
Else
sError=""
ValidateData() ' need to validate anything, nothing is required
If checkForExistingCustomer(strLastName, strEmail, strPassword1) then
sError = sError & LangCustomerExists & " "
end if
if sError = "" Then
UpdateOrderInformation ' put in customer and order data
SetSess "Login",strlastname
Response.Redirect GetSess("FollowonURL")
else
DisplayEverything
end if
end if
' End of main logic
Sub DisplayEveryThing
ShopPageHeader ' Normal page header
Displayerrors ' any input errors
GetShippingDatabase ' get shipping database
GetCustomerSessionData ' get customer info from session
DisplayForm ' display customer and shipping form
ShopPageTrailer ' Normal page trailer
end Sub
'
Sub DisplayForm()
Response.Write("
")
AddLogin ' User login form
Response.Write("")
Response.Write("
")
End Sub
'
Sub addShippingForm
If getconfig("xshippingform")="No" then exit sub
ShopShippingForm ' in shopcustomerform.asp
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")
strshipname = Request.Form("shipname")
strshipcompany = Request.Form("shipcompany")
strshipaddress = Request.Form("shipaddress")
strshiptown = Request.Form("shiptown")
strshipzip = Request.Form("shipzip")
strshipstate = Request.Form("shipstate")
strshipcountry = Request.Form("shipcountry")
strShipComment=request.form("shipcomment")
strPassword1 = Request.Form("strPassword1")
strPassword2 = Request.Form("strPassword2")
strgiftcertificate=request("strgiftcertificate")
strCoupon=request("strcoupon")
blnMailList=request("blnMaillist")
CustomerGetFields ' Get additional fields
ValidateCustomerFields
ShipMethodType= Request("ShipMethodType")
'debugwrite "shipmethodtype=" & shipmethodtype
If ShipMethodType = LangCommonSelect Then
sError = sError & LangShippingError & " "
End If
ValidatePassword
ValidateGiftCertificate
ValidateCustCoupon
End Sub
Sub AddOptionalStuff
If getconfig("xPromptForOptional")="Yes" then
Response.Write(" " & LangCust02 & "")
Response.Write(TableDef)
CreateCustRow LangCustWebsite, "strwebsite", strwebsite,"No"
CreateCustRow LangCustWorkphone, "strWorkphone", strWorkPhone, "No"
CreateCustRow LangCustMobilephone, "strMobilephone", strMobilePhone, "No"
CreateCustRow LangCustFax, "strFax", strFax, "No"
Response.Write("
")
end if
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
CheckForDuplicate rc
if rc > 0 then
SError= SError & LangPasswordDuplicate & " "
end if
else
Serror=Serror & LangPasswordLength & " "
end if
end if
end if
end if
End sub
Sub DisplayCart
CartFormat "NO" ' format cart
end sub
Sub addLogin
If GetSess("Login")<>"" and Getsess("Lastname") <>"" then
exit sub
end if
If getconfig("xPromptForLogin")<>"Yes" then exit sub
If ucase(getconfig("Xpassword"))="YES" then
Response.Write("
"
response.write ("" & LangLoginForgot & "")
else
Response.Write(""
end if
end sub
Sub DisplayErrors
if sError<> "" then
response.write "" & getconfig("Xfont") & 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
dim rs
OpenCustomerDb myconn
sql = "select * from customers where lastname='" & strlastname & "' and password ='" & strpassword1 & "'"
sql = sql & " and email='" & stremail & "'"
'debugwrite sql
Set rs = myconn.Execute(SQL)
If Not rs.EOF Then
rc=4
else
rc=0
end if
rs.close
shopclosedatabase myconn
end sub
Sub addnewUser
response.write ("
")
end sub
Sub addInformationTable
response.write "
" & getconfig("xfont")
If GetSess("Login")="" then
Response.Write LangCustomerPrompt & " "
end if
If getconfig("xshippingform")="Yes" then
Response.Write LangShip01 & " " & LangShip02
end if
Response.write "
"
end Sub
'
Sub ValidateEmail
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & LangInvalidEmail & " "
end if
End sub
Sub CheckMinimumOrder
Dim MinMessage
dim MinimumOrder
If getconfig("xMinimumOrder")<>"" then
MinimumOrder=csng(getconfig("xMinimumOrder"))
If GetSess("OrderProductTotal")< MinimumOrder then
MinMessage = LangMinimumOrder & " " & shopformatcurrency(getconfig("xMinimumOrder"),getconfig("xdecimalpoint")) & " "
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (MinMessage)
end if
end if
If getconfig("xMaximumOrder")<>"" then
MinimumOrder=csng(getconfig("xMaximumOrder"))
If GetSess("OrderProductTotal")> MinimumOrder then
MinMessage = LangMaximumOrder & " " & shopformatcurrency(getconfig("xMaximumOrder"),getconfig("xdecimalpoint")) & " "
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (MinMessage)
end if
end if
end sub
'
Sub SetupCustomer
' **********************************************************************
' Set defaults here
'**********************************************************************
dim rc
SetSess "CurrentURL", "shopcustomer.asp"
SetSess "FollowonURL","shopcustomer.asp" ' force login to come back to us
'SetSess "smprice","" ' no price
' Do database stuff
if GetSess("CartCount")=0 or GetSess("CartCount")="" then
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (LangError01)
end if
CheckMinimumOrder
VerifyDeliveryAddress rc
If rc>0 then
response.redirect "shopdeliveryaddress.asp"
end if
end sub
' adds to customer table, order table, oitems table
Sub UpdateOrderInformation
strDiscount=GetSess("CustDiscount") ' fix for discount
if getconfig("xAllowCustomerUpdates")="Yes" or GetSess("Login")="" then
UpdateContact
end if
strCustomerid=GetSess("Customerid")
strDiscount=GetSess("CustDiscount")
UpdateCustomerSessionData
SetSess "FollowonURL","shopcreateorder.asp" ' this is followon unless chnaged
UpdateShippingSessionData ' update shipping date in session variables
End Sub
'
Sub AddGiftCertificate
If getconfig("xGiftCertificates")<>"Yes" then exit sub
strGiftCertificate=Getsess("GiftCertificate")
Response.Write("
" & getconfig("xfont") & LangGiftEnter & "")
Response.Write(TableDef)
CreateCustRow LangGiftCertificate, "strGiftcertificate", strgiftcertificate,"No"
Response.Write(tableDefEnd)
end sub
Sub AddDiscountCoupon
strcoupon=getsess("coupon")
If getconfig("xAllowCoupons")<>"Yes" then exit sub
Response.Write("
" & getconfig("xfont") & LangCustCouponPrompt & "")
Response.Write(TableDef)
CreateCustRow LangCouponDiscount,"strCoupon",strCoupon,""
Response.Write(tableDefEnd)
end sub
'
Sub ValidateGiftCertificate
dim msg
If getconfig("xGiftCertificates")<>"Yes" then exit sub
SetSess "giftamountmax",""
SetSess "giftamountused",""
if strgiftcertificate="" then exit sub
msg=""
ShopvalidateGiftCertificate strgiftcertificate, msg
If msg<>"" then
Serror=SError & Msg & " "
strGiftCertificate=""
end if
end sub
Sub ValidateCustCoupon
dim msg, rc
if strcoupon="" then exit sub
LocateCoupon strcoupon, rc, msg
if msg="" then
SetSess "coupon",strcoupon
else
Serror=SError & Msg & " "
' strCoupon=""
end if
end sub
Function checkForExistingCustomer(LastName, emailvalue, passwordvalue) 'As Boolean
Dim rs
dim myconn
dim templastname
dim whereok
dim blnCustomer 'As Boolean
blnCustomer=False
if sError<>"" then exit function
If getconfig("xCheckexistingcustomer")<>"Yes" Then exit function
if GetSess("Login")<>"" then exit function
if lastname<>"" then
templastname=replace(lastname,"'","''")
end if
' See if customer stored separately
OpenCustomerDb myconn
sql = "select * from customers where "
whereok=""
If lastname<>"" then
sql=sql & whereok & " lastname='" & templastname & "'"
whereok = " AND "
end if
if emailvalue<> "" then
SQL = SQL & whereok & " email='" & emailvalue & "'"
end if
'If passwordvalue<>"" then
' SQL = SQL & " AND " & " password='" & passwordvalue & "'"
'end if
'debugwrite sql
Set rs = myconn.Execute(SQL)
If Not rs.EOF Then
ResetCustomerSessionData
blnCustomer=True
else
blnCustomer=False
end if
rs.close
set rs=nothing
ShopClosedatabase myconn
checkForExistingCustomer=blnCustomer
end Function
Sub GetGiftregsessiondata
if getconfig("xgiftregistry")<>"Yes" then exit sub
If GetSess(REGISTRY) <> "" Then
SetRegistryShippingInfo
GetRegistryShippingInfo
End If
end sub
%>