<%option explicit%>
<%
'*********************************************************
' Display customer, shipping forms form is now in shopcustomerform.asp
' Version 5.50
' add shopa_restoreorder.asp facility
' Add License, Hacker
' Address Address2
' NOv 1, 2004 correct shipaddress2
'*********************************************************
Dim strPassword1, strPassword2, ShipMethodType
Dim msg, newcust, strcoupon, Restorefromcookie
Dim i, sAction, Oid, dbc, scartitem, arrCart, Length
dim cookielogin, straffid, straffid1
' 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 & getlang("langCustomerExists") & " "
end if
if sError = "" Then
UpdateOrderInformation ' put in customer and order data
SetSess "Login",strlastname
responseredirect GetSess("FollowonURL")
else
UpdateCustomerSessionData
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" and getconfig("xshippingselection")="No" then exit sub
If Getconfig("xgiftregistry")="Yes" and getsess(REGISTRANTID)<>"" Then exit sub
ShopShippingForm ' in shopcustomerform.asp
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")
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")
blncookiequestion=request("blncookiequestion")
If blncookiequestion="" then
blncookiequestion=false
else
blncookiequestion=True
end if
strvatnumber=request("vatnumber")
strcustuserid=request.form("strcustuserid")
strhearaboutus= Request("hearaboutus")
strAddress2 = Request.Form("strAddress2")
strshipAddress2 = Request.Form("shipAddress2")
CustomerGetFields ' Get additional fields
ShippingGetOtherFields ' 4.50
ValidateCustomerFields
ShipMethodType= Request("ShipMethodType")
'debugwrite "shipmethodtype=" & shipmethodtype
If ShipMethodType = getlang("langCommonSelect") Then
sError = sError & getlang("langShippingError") & " "
End If
strcustomertype=getsess("customertype")
ValidatePassword
ValidateGiftCertificate
ValidateCustCoupon
Validatelicense
ValidateDeliverydateTime
GetAffInfo
if getsess("Login")="" then
Validateusername strcustuserid, serror, rc ' In shopcustomer
end if
End Sub
Sub AddOptionalStuff
If getconfig("xPromptForOptional")="Yes" then
response.write " "
shopwriteheader 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 strPassword1<>"" then
If StrPassword1<>strPassword2 then
SError= SError & getlang("langPasswordMismatch") & " "
else
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
else
if getsess("Login")="" then
sError = sError & getlang("langpassword") & getlang("langCustRequired") & " "
end if
end if
If getconfig("xcustomeruserid")="Yes" then
if getsess("Login")="" then
If strcustuserid = "" Then
sError = sError & getlang("langAdminusername") & getlang("langCustRequired")& " "
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
shopwriteHeader getlang("langCust01")
ShopLoginForm
end sub
Sub DisplayErrors
if sError<> "" then
shopwriteError SError
Serror=""
end if
end Sub
Sub AddSubmitButton
Shopbutton Getconfig("xbuttoncontinue"),trim(getlang("langCommonContinue")),""
end sub
Sub CheckForDuplicate (rc)
Dim testsql
dim myconn
dim rs
OpenCustomerDb myconn
dim tpassword, tlastname, tmail
tlastname=replace(strlastname,"'","''")
tpassword=replace(strpassword1,"'","")
tmail=replace(stremail,"'","")
sql = "select * from customers where lastname='" & tlastname & "' and password ='" & tpassword & "'"
sql = sql & " and email='" & tmail & "'"
'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 "
" & largeinfofont
If GetSess("Login")="" then
Response.Write getlang("langCustomerPrompt") & " "
end if
If getconfig("xshippingform")="Yes" or getconfig("xshippingselection")="Yes" then
shopwriteheader getlang("langShip01") & " " & getlang("langShip02")
end if
Response.write largeinfoend & "
"
end Sub
'
Sub ValidateEmail
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("langInvalidEmail") & " "
end if
End sub
Sub CheckMinimumOrder
Dim MinMessage
dim MinimumOrder, ordertotal
If GetSess("OrderProductTotal")="" then
ordertotal=Getproductordertotal
setsess "OrderProductTotal",ordertotal
end if
If getconfig("xMinimumOrder")<>"" then
MinimumOrder=csng(getconfig("xMinimumOrder"))
If GetSess("OrderProductTotal")< MinimumOrder then
MinMessage = getlang("langMinimumOrder") & " " & shopformatcurrency(getconfig("xMinimumOrder"),getconfig("xdecimalpoint")) & " "
shoperror MinMessage
end if
end if
If getconfig("xMaximumOrder")<>"" then
MinimumOrder=csng(getconfig("xMaximumOrder"))
If GetSess("OrderProductTotal")> MinimumOrder then
MinMessage = getlang("langMaximumOrder") & " " & shopformatcurrency(getconfig("xMaximumOrder"),getconfig("xdecimalpoint")) & " "
shoperror 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 "shipmessage",""
'SetSess "smprice","" ' no price
' Do database stuff
if GetSess("CartCount")=0 or GetSess("CartCount")="" then
shoperror getlang("langError01")
end if
if getsess("adminrestore")<>"" then
responseredirect "shopa_createorder.asp"
end if
CheckMinimumOrder
VerifyDeliveryAddress rc
If rc>0 then
responseredirect "shopdeliveryaddress.asp"
end if
If getconfig("xproductdependentfield")<>"" then
ShopProductDependent rc
If rc>0 then
shopdependentmessage serror
shoperror serror
end if
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")
CorrectShippingFields
UpdateCustomerSessionData
Updatecookiedata
Checkhacker
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("
")
shopwriteheader getlang("langGiftEnter")
Response.Write(TableDef)
CreateCustRow getlang("langGiftCertificate"), "strGiftcertificate", strgiftcertificate,"No"
Response.Write(tableDefEnd)
end sub
Sub AddDiscountCoupon
strcoupon=getsess("coupon")
If getconfig("xAllowCoupons")<>"Yes" then exit sub
Response.Write("
")
shopwriteheader getlang("langCustCouponPrompt")
Response.Write(TableDef)
CreateCustRow getlang("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
CouponValidateSpecial strcoupon,msg
if msg="" then
SetSess "coupon",strcoupon
else
strcoupon=""
SetSess "coupon",strcoupon
Serror=SError & Msg & " "
end if
else
Serror=SError & Msg & " "
SetSess "coupon",""
' strCoupon=""
end if
end sub
Function checkForExistingCustomer(LastName, emailvalue, passwordvalue) 'As Boolean
Dim rs
dim myconn
dim templastname
dim whereok
dim blnCustomer 'As Boolean
dim tempemailvalue, temppasswordvalue
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
tempemailvalue=replace(emailvalue,"'","")
temppasswordvalue=replace(temppasswordvalue,"'","")
' 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='" & tempemailvalue & "'"
end if
'If passwordvalue<>"" then
' SQL = SQL & " AND " & " password='" & temppasswordvalue & "'"
'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
Sub CorrectShippingFields
If getconfig("Xshippingsetfields")<>"Yes" then exit sub
Correctship strshipname,strfirstname & " " & strlastname
correctship strshipcompany , strcompany
correctship strshipaddress, straddress
correctship strshiptown, strcity
correctship strshipzip,strpostcode
correctship strshipstate,strstate
correctship strshipcountry, strcountry
correctship strshipaddress2, straddress2
end sub
Sub Correctship (shipfield, normfield)
if shipfield<>"" then exit sub
shipfield=normfield
end sub
'***********************************************************************
' adds a license url to display
'*************************************************************************
Sub AddLicense
dim blnlicense
dim licenseurl
blnlicense=Request.Form("blnlicense")
If blnlicense="" then
blnlicense=getsess("Licenseagreement")
end if
licenseurl=Getconfig("Xlicenseurl")
If getconfig("Xlicenseagreement")<>"Yes" then exit sub
If licenseurl="" then exit sub
Response.Write(TableDef)
Response.Write tablerow
Response.write TableColumn
Response.Write "
"
Response.write "" & getlang("langLicenseAgreement") & ""
Response.Write tablecolumnend
Response.Write tablerowend
Response.Write tablerow
Response.write TableColumn
Response.Write getlang("langlicenseagreementcheck")
Response.Write tablecolumnend
Response.write TableColumn
If blnlicense<>"" then%>
<%Else%>
<%
End if
response.write ""
end Sub
sub validatelicense
if getconfig("xlicenseagreement")<>"Yes" then exit sub
dim blnlicense
blnlicense=Request.Form("blnlicense")
if not blnlicense then
serror=serror & getlang("langlicenseforce") & " "
setsess "Licenseagreement",""
else
Setsess "Licenseagreement","Yes"
end if
end sub
Sub Checkhacker
dim rc, ipaddress
If getconfig("xhackercheck")<>"Yes" then exit sub
ipaddress=request.servervariables("REMOTE_ADDR")
ShopCheckHacker stremail, ipaddress, strcountry, rc
if rc> 0 then
shoperror getlang("LangStorehacker") & " - " & rc
end if
end sub
'************************************************************************
' Update or resrt cookie
'***********************************************************************
Sub Updatecookiedata
If getconfig("xCookieLogin")<>"Yes" then exit sub
If blnCookieQuestion then exit sub
response.cookies("CartLogin").expires=date()-2
end sub
'
'************************************************************************
' Should affiliate info be generated in form
'***********************************************************************
Sub Addaffiliate
If getconfig("xaffcustomerform")<>"Yes" then exit sub
dim affconn
straffid=getsess("affid")
If straffid<>"" then
If isnumeric(straffid) then
straffid=clng(straffid)
end if
end if
Openaffiliatedb affconn
shopwriteheader getlang("LangAff")
Response.Write(TableDef)
CreateCustRow getlang("LangAffID"),"straffid",straffid,""
Response.Write(tableRow & tablecolumn & "" & getlang("langaff") & tablecolumnend & "
")
Response.Write(tableDefEnd)
shopclosedatabase affconn
end sub
'********************************************************************
' See what customer selected and check it if it was not from
' drop down list'
'***********************************************************
Sub GetAffInfo
If getconfig("xaffcustomerform")<>"Yes" then exit sub
dim ars, asql, affconn
straffid=request("straffid")
straffid1=request("straffid1")
If straffid1=getlang("langcommonselect") then
straffid1=""
end if
if straffid="" and straffid1="" then
exit sub
end if
If straffid1<>"" then
straffid=straffid1
setsess "affid", straffid
exit sub
end if
If not isnumeric(straffid) then
straffid=""
serror= serror & getlang("LangaffidInvalid") & " "
setsess "affid",""
exit sub
end if
Openaffiliatedb affconn
asql="select * from affiliates where affid=" & straffid
set ars=affconn.execute(asql)
if ars.eof then
serror=serror & getlang("LangaffNotFound") & " " & straffid & " "
setsess "affid",""
straffid=""
else
setsess "affid", straffid
end if
closerecordset ars
shopclosedatabase affconn
end sub
%>