<%Option explicit%>
<%
Const RestoreCartUrl="shopaddtocart.asp"
'********************************************************************
' VP-ASP 4.50 June 6, 2002 fix cart overflow
' Saves and restores carts as cookies
' *********************************************************************
const VPASPCARTS="VPASPCARTS"
Const SavedExpirydays=365
dim msg
Dim sAction, cartname, cartdays
dim cartstr, carts, cartcount, delimiter
Dim infomsg
sError=""
sAction=Request("action")
ShopPageHeader
if saction="" then
sAction=Request("action.x")
end if
If sAction <> "" Then
HandleAction
end if
DisplayForm
ShopPageTrailer
Sub HandleAction
dim uaction
uaction=ucase(sACTION)
Select Case uaction
Case "SAVE"
PerformSaveCart
Case "RESTORE"
PerformRestoreCart
Case "DELETE"
PerformDeleteCart
end select
end sub
Sub DisplayForm()
cartdays=savedExpirydays
Response.Write(xfont & "" & sError & "
")
if infomsg<>"" then
Response.Write(xfont & "" & infomsg & "
")
end if
Response.Write(Xfont & LangCartSaveInfo &"
")
DisplayCurrentCarts
Response.Write("")
End Sub
'
Sub PerformSaveCart
dim arrcart, scartitem, cartname
arrcart=Getsessa("CartArray")
scartitem=Getsess("CartCount")
Cartdays=request("CartDays")
If cartdays="" then
cartdays=1
else
if not isnumeric(cartdays) then
cartdays=1
end if
end if
cartname=request("cart")
if cartname="" then
Serror=LangCartMissing
exit sub
end if
If scartitem="" or scartitem="0" then
Serror=LangError01
exit sub
end if
SessionSaveCart "Savedcart", arrcart, cartname, cartdays
infomsg = LangcartSaved & " " & cartname &"
"
UpdateCartInfo cartname
end sub
Sub UpdateCartInfo (cart)
'*************************************************************
' maintain a list of carts a,b,c
'*************************************************************
dim ucart, i
cartstr=request.cookies(VPASPCARTS)
If cartstr="" then
cartstr=cart
Response.Cookies(VPASPCARTS)=cartstr
Response.cookies(VPASPCARTS).expires=date()+365
exit sub
end if
ParseCarts
ucart=ucase(cart)
for i = 0 to cartcount-1
if ucart=ucase(carts(i)) then
exit sub
end if
next
cartstr=cartstr & ";" & cart
Response.Cookies(VPASPCARTS)=cartstr
Response.cookies(VPASPCARTS).expires=date()+365
'debugwrite "vpaspcarts after=" & cartstr
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=LangCartMissing
exit sub
end if
SessionRestoreCart "savedcart", tempcart, tempcartcount, cartname, 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
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (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
Response.redirect RestoreCartUrl
else
Infomsg=LangCartRestored & " " & cartname & "
"
end if
else
infomsg=LangCartNotFound
end if
end sub
Sub SessionSaveCart (field, value, cookiekey, cartdays)
'*****************************************************************
' cart is saved as 1 cookie per product. product is converted to a string
' addition cookie cartcount is the number of products in the cart
'*********************************************************************
dim expires
dim cartcount, arrcount, dataarea, j, countkeyname
dim keyname
dim i, cartattributes
cartattributes=cMaxCartAttributes
expires=date+cartdays
cartcount=getsess("CartCount")
if cartcount="" or cartcount=0 then exit sub
for i = 1 to cartcount
dataarea=""
for j = 1 to cartAttributes
dataArea= dataarea & value(j, i) & ";"
next
keyname= field & cstr(i)
' debugwrite keyname & " " & dataarea & " " & cookiekey
Response.cookies(Cookiekey) (keyname)=dataarea
Response.cookies(Cookiekey).expires=expires
next
countkeyname="CartCount"
Response.cookies(Cookiekey) (countkeyname)=cartcount
Response.cookies(Cookiekey).expires=expires
end sub
'
Sub SessionRestoreCart (field, value, cartcount, cookiekey, rc)
dim arrcount, dataarea, Temparray(20), tempcount
dim arrcart, cartattributes
cartattributes=cMaxCartAttributes
dim i, j, keyname, countkeyname
rc=0
countkeyname="CartCount"
cartcount=Request.cookies(Cookiekey) (countkeyname)
If cartcount="" or Cartcount=0 then
rc=4
exit sub
end if
ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
value=arrcart
for i = 1 to cartcount
keyname= field & cstr(i)
dataarea=Request.cookies(Cookiekey) (keyname)
'debugwrite dataarea
ParseRecord dataarea, TempArray, tempcount, ";"
for j = 1 to cartAttributes
'temparray(j-1)=replace(temparray(j-1),".",",")
value(j,i)= temparray(j-1)
next
next
end sub
Sub DisplayCurrentCarts
dim i
cartstr=request.cookies(VPASPCARTS)
If cartstr="" Then
Response.write "
" & xfont & LangNoSavedCarts & "
"
exit sub
end if
ParseCarts
OrderTableHeader
for i = 0 to cartcount-1
OrderFormatRow carts(i) ' actual row is formatted
next
response.write ""
end sub
Sub OrderFormatRow (cart)
dim my_link, fieldvalue
my_link="shopsavecart.asp?Action=RESTORE&cart=" & Server.urlencode(cart)
fieldvalue="" & LangCommonYes & ""
response.write ""
response.write ReportDetailColumn & cart & ReportDetailcolumnEnd
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
my_link="shopsavecart.asp?Action=DELETE&cart=" & Server.urlencode(cart)
fieldvalue="" & LangCommonYes & ""
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
response.write "
"
End Sub
Sub OrderTableHeader
dim i, captions(10), fieldcount
Captions(0)=LangSaveCartName
Captions(1)=LangCartRestore
Captions(2)=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
Sub PerformDeleteCart
dim i, cartname, ucart
cartname=request("Cart")
cartstr=request.cookies(VPASPCARTS)
If cartstr="" then exit sub
ParseCarts
ucart=ucase(cartname)
cartstr=""
for i = 0 to cartcount-1
if ucart<>ucase(carts(i)) then
if cartstr="" then
cartstr=carts(i)
else
cartstr=cartstr & ";" & carts(i)
end if
end if
next
Response.Cookies(VPASPCARTS)=cartstr
Response.cookies(VPASPCARTS).expires=date()+365
Response.cookies(cartname).expires=date()-1
Infomsg=LangcartDeleted & " " & cartname
end sub
Sub ParseCarts
redim carts(getconfig("xMaxSAvedCarts"))
delimiter=";"
ParseRecord cartstr,carts,cartcount,delimiter
end sub
%>