%Option explicit%>
<%
Const RestoreCartUrl="shopaddtocart.asp"
'********************************************************************
' VP-ASP 5.00 April 26, 2003
' Saves and restores carts as cookies
' Nov 26, 2003 support delivery address
' *********************************************************************
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
shopwriteerror SError
if infomsg<>"" then
shopwriteheader infomsg
end if
shopwriteheader getlang("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= getlang("LangCartMissing")
exit sub
end if
If scartitem="" or scartitem="0" then
Serror= getlang("LangError01")
exit sub
end if
SessionSaveCart "Savedcart", arrcart, cartname, cartdays
infomsg = getlang("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, deliveryvalue
cartname=Request("cart")
If cartname="" then
Serror= getlang("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
shoperror getlang("Langerror02")
End If
for j=1 to cartattributes
If j=cDelivery then
Restoredelivery tempcart(j,i), deliveryvalue
arrCart(j,scartitem) = deliveryvalue
'VP-ASP 6.08a - Images were missing / on restore - 6.09 - slash no longer removed, so doesn't need to be replaced
'elseif j = cProductimage then
' arrCart(j,scartitem) = replace(tempcart(j,i), " ","/")
else
arrCart(j,scartitem) = tempcart(j,i)
end if
next
If getconfig("XdualPrice")="Yes" Then
Price=arrcart(cunitprice, scartitem)
Convertcurrency price, arrcart(cdualprice, scartitem)
end if
If arrcart(cProductMiniName,scartitem)="" then
arrcart(cProductMiniName,scartitem)=arrcart(cProductName,scartitem)
end if
next
SetSessA "CartArray",arrCart
SetSess "CartCount",scartitem
If RestoreCartUrl<>"" then
Responseredirect RestoreCartUrl
else
Infomsg= getlang("LangCartRestored") & " " & cartname & "
"
end if
else
infomsg= getlang("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, deliveryvalue
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
'VP-ASP 6.08a - Not sure why spaces were being removed, but it messes up the display on restore.
'value(j, i)=replace(value(j, i)," ","")
value(j, i)=replace(value(j, i),"'","")
value(j, i)=replace(value(j, i),"&","and")
'VP-ASP 6.09 - don't remove slashes - was breaking restore with images
'value(j, i)=replace(value(j, i),"/"," ")
value(j, i)=replace(value(j, i),","," ")
value(j, i)=replace(value(j, i),"""","")
value(j, i)=replace(value(j, i),":","")
value(j, i)=replace(value(j, i),";","")
If j=cDelivery then
Savedelivery value(j, i), deliveryvalue
dataArea= dataarea & deliveryvalue & ";"
else
dataArea= dataarea & value(j, i) & ";"
end if
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(25), 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 "
" & largeinfofont & getlang("LangNoSavedCarts") & largeinfoend & "
"
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="" & getlang("LangCommonYes") & ""
response.write ""
response.write ReportDetailColumn & cart & ReportDetailcolumnEnd
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
my_link="shopsavecart.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
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= getlang("LangcartDeleted") & " " & cartname
end sub
Sub ParseCarts
redim carts(getconfig("xMaxSAvedCarts"))
delimiter=";"
ParseRecord cartstr,carts,cartcount,delimiter
end sub
Sub SaveDelivery (deliveryarray, returnvalue)
returnvalue=""
If getconfig("xdeliveryAddress")<>"Yes" then exit sub
If not isarray(deliveryarray) then exit sub
ConvertDeliveryToString DeliveryArray, returnvalue
returnvalue=replace(returnvalue,deliverydelimiter,"!")
end sub
Sub RestoreDelivery (istring, deliveryarray)
deliveryarray=""
If getconfig("xdeliveryAddress")<>"Yes" then exit sub
If istring="" then exit sub
istring=replace(istring,"!",deliverydelimiter)
ConvertDeliveryToArray DeliveryArray, istring
end sub
%>