<%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("
") Response.Write(TableDef) Response.Write(tablerow & tablecolumn & getlang("LangSaveCartName") & tablecolumnend & "") Response.Write(tablerow & tablecolumn & getlang("LangCartDays") & tablecolumnend & "") Response.Write("") If Getconfig("xbuttoncontinue")="" Then Response.Write("") else Response.Write("") end if 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 %>