<%Option explicit%>
<%
Const RestoreCartUrl="shopaddtocart.asp"
'********************************************************************
' Saves and restores carts as in database
' VP-ASP 5.0 Permanent wish list Feb 4, 2003
' *********************************************************************
dim msg, conn
Dim sAction, cartname, cartdays
dim cartstr, carts, cartcount, delimiter
Dim infomsg, customerid
customerid=getsess("customerid")
sError=""
sAction=Request("action")
shopopendatabase conn
ShopPageHeader
If getsess("customerid") = "" then
Responseredirect "shopcustadminlogin.asp"
end if
if saction="" then
sAction=Request("action.x")
end if
If sAction <> "" Then
HandleAction
end if
DisplayForm
ShopPageTrailer
shopclosedatabase conn
'
Sub HandleAction
dim uaction
uaction=ucase(sACTION)
Select Case uaction
Case "SAVE"
PerformSaveCart
Case "RESTORE"
PerformRestoreCart
Case "DELETE"
PerformDeleteCart
end select
end sub
'**********************************************************************
' Tell customer what carts they have and allow them to delete. restore
'*********************************************************************
Sub DisplayForm()
shopwriteerror sError
if infomsg<>"" then
shopwriteheader infomsg
end if
Shopwriteheader getlang("LangWishList")
DisplayCurrentCarts
Response.Write("")
End Sub
'
'************************************************************
' save cart in database under name supplied by customer
' saved by customerid and name
'**********************************************************
Sub PerformSaveCart
dim arrcart, scartitem, cartname
arrcart=Getsessa("CartArray")
scartitem=Getsess("CartCount")
cartname=request("cart")
if cartname="" then
Serror= getlang("LangCartMissing")
exit sub
end if
If scartitem="" or scartitem="0" then
Serror= getlang("LangError01")
exit sub
end if
SessionSaveCart cartname
infomsg = getlang("LangcartSaved") & " " & cartname &"
"
end sub
'
Sub SessionSaveCart (cartname)
'*****************************************************************
' cart is affields separted by |
'
'*********************************************************************
dim expires, arrcart
dim cartcount, arrcount, dataarea, j, countkeyname
dim keyname
dim i, cartattributes
dim sCookiestring
cartattributes=cMaxCartAttributes
arrcart=Getsessa("CartArray")
cartcount=getsess("CartCount")
if cartcount="" or cartcount=0 then exit sub
dataarea=""
scookiestring=""
for i = 1 to cartcount
dataarea=""
for j = 1 to cartAttributes
dataArea= dataarea & arrcart(j, i) & ";"
next
If sCookiestring<>"" Then
sCookieSTring=scookiestring & "|"
end if
sCookieString = sCookieString + dataarea
next
SaveToDatabase cartname, sCookieString
end sub
'*************************************************************
' Either add a new one or update existing one
'****************************************************************
Sub SaveTodatabase (cartname, sCookiestring)
dim sql, rc, tcartname
tcartname=replace(cartname,"'","''")
sCookieString=replace(sCookieString,"'","''")
Locatecart tcartname, rc
If rc=0 then
sql="update savedcarts set cartcookies='" & scookiestring & "'"
sql=sql & " where customerid=" & getsess("customerid")
sql = sql & " and cartname='" & tcartname & "'"
else
sql = "insert into savedcarts (customerid, cartname, cartcookies)"
sql = sql & "values ( " & getsess("customerID") & ", '"
sql = sql & tcartname & "', '" & sCookieString & "')"
end if
conn.execute(sql)
end sub
Sub Locatecart (cartname, rc)
rc=4
dim sql, rs
sql="select * from savedcarts where customerid=" & getsess("customerid")
sql=sql& " and cartname='" & cartname & "'"
set rs=conn.execute(sql)
if rs.eof then
rc=4
else
rc=0
end if
closerecordset rs
end sub
Sub PerformRestoreCart
'******************************************************
' take the cart and put in back in memory
'*****************************************************
dim arrcart, scartitem, rc, tempcartcount
dim tempcart, i, j, price
cartname=Request("cart")
If cartname="" then
Serror= getlang("LangCartMissing")
exit sub
end if
Getcartvalues customerid, cartname, tempcartcount, tempcart, rc
If rc=0 then
scartItem = GetSess("CartCount")
If scartitem="" then
ShopInit
scartItem = GetSess("CartCount")
end if
arrCart = GetSessA("CartArray")
dim cartattributes
cartattributes=cMaxCartAttributes
for i = 1 to tempcartcount
scartitem=scartitem+1
If scartItem > clng(getconfig("xMaxCartitems")) then
ResponseRedirect "shoperror.asp?msg=" & Server.URLEncode ( getlang("Langerror02"))
End If
for j=1 to cartattributes
arrCart(j,scartitem) = tempcart(j,i)
next
If getconfig("XdualPrice")="Yes" Then
Price=arrcart(cunitprice, scartitem)
Convertcurrency price, arrcart(cdualprice, scartitem)
end if
next
SetSessA "CartArray",arrCart
SetSess "CartCount",scartitem
If RestoreCartUrl<>"" then
shopclosedatabase conn
Responseredirect RestoreCartUrl
else
Infomsg= getlang("LangCartRestored") & " " & cartname & "
"
end if
else
infomsg= getlang("LangCartNotFound")
end if
end sub
'
sub Getcartvalues (customerid, cartname, tempcartcount, tempcart, rc)
dim arrcount, dataarea, Temparray(30), tempcount
dim carts, cartcount
dim arrcart, cartattributes
cartattributes=cMaxCartAttributes
dim i, j, keyname, countkeyname
tempcartcount=0
rc=0
dim sql, records
' get all carts for this user
sql = "SELECT * FROM savedcarts "
sql = sql & "WHERE cartname = '" & trim(cartname) & "'"
sql=sql & " and customerid=" & getsess("customerid")
Set records = conn.execute(sql)
If records.EOF Then
closerecordset records
rc=4
exit sub
end if
dataarea=records("cartcookies")
closerecordset records
ParseCarts dataarea, carts, cartcount
ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
tempcart=arrcart
tempcartcount=cartcount
for i = 0 to cartcount-1
ParseRecord Carts(i), TempArray, tempcount, ";"
for j = 1 to cartAttributes
tempcart(j,i+1)= temparray(j-1)
' debugwrite temparray(j-1)
next
next
rc=0
end sub
'********************************************************************
' read all carts for this customerid
'*********************************************************************
Sub DisplayCurrentCarts
dim i, carts(100), cartcount
Getcartsfromdatabase carts, cartcount
If cartcount=0 Then
shopwriteerror getlang("LangNoSavedCarts")
exit sub
end if
OrderTableHeader
for i = 0 to cartcount-1
OrderFormatRow carts(i) ' actual row is formatted
next
response.write ""
end sub
sub GetCartsFromDatabase (carts, cartcount)
dim sql, records
cartcount=0
' get all carts for this user
sql = "SELECT * from savedcarts "
sql = sql & " WHERE customerid = " & getsess("CustomerID")
Set records = conn.execute(sql)
do while not records.eof
carts(cartcount)=records("cartname")
cartcount=cartcount+1
records.movenext
loop
records.close
set records=nothing
end sub
'*******************************************************************
' Format actions a for one cart
'********************************************************************
Sub OrderFormatRow (cart)
dim my_link, fieldvalue
my_link="shopsaveperm.asp?Action=RESTORE&cart=" & Server.urlencode(cart)
fieldvalue="" & getlang("LangCommonYes") & ""
response.write ""
response.write ReportDetailColumn & cart & ReportDetailcolumnEnd
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
my_link="shopsaveperm.asp?Action=DELETE&cart=" & Server.urlencode(cart)
fieldvalue="" & getlang("LangCommonYes") & ""
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
response.write "
"
End Sub
Sub OrderTableHeader
dim i, captions(10), fieldcount
Captions(0)= getlang("LangSaveCartName")
Captions(1)= getlang("LangCartRestore")
Captions(2)= getlang("LangMenuDelete")
fieldcount=3
response.write "
" & ReportTableDef
response.write ReportHeadrow
for i = 0 to fieldcount-1
Response.write ReportHeadColumn & Captions(i) & ReportHeadColumnEnd
next
response.write ReportRowend
end sub
'**********************************************************
' Delete cart from database based on name and customerid
'*********************************************************
Sub PerformDeleteCart
dim i, cartname, ucart
cartname=request("Cart")
dim sql
sql = "delete from savedcarts where cartname = '" & cartname & "'"
sql=sql & " and customerid=" & getsess("customerid")
conn.execute(sql)
end sub
Sub ParseCarts (cartstr, carts, cartcount)
redim carts(getconfig("xMaxSAvedCarts"))
delimiter="|"
debugwrite cartstr
ParseRecord cartstr,carts,cartcount,delimiter
end sub
%>