<%
'************************************************************
' Version 6.50 July 7, 2005
' This routine displays the shopping cart and does recalculation
' if returnurl is passed, this routine returns back to that URL
' Have added recalculate functionality to Proceed - Dean 20/1/2006
'****************************************************************
Dim prodid, quantity, arrCart, scartItem
Dim strAction, pi, dualreprice
Dim returnurl
dim ContinueURL
dim Newcart
Dim Newcount
Dim tquantity
Dim confirm
dim testremove
Dim x
dim msg, stocklevel
ContinueURL=getconfig("xcontinueshopping")
If getconfig("xcontinueshoppingdynamic")="Yes" then
Setcontinueurl continueurl
If continueurl="" then
ContinueURL=getconfig("xcontinueshopping")
end if
end if
'******************************
' This form can call itself.
' We need to know if it is a new product add or just a recalculation
' Inputs are productid, quantity
'
'*******************************
sError=""
strAction=Request("Continue")
If straction="" then
strAction=Request("Continue.x")
end if
if straction<>"" then
strAction="CONTI"
else
strAction=Request("Checkout")
If straction="" then
straction=Request("Checkout.x")
end if
if straction<> "" then
strAction="PROCE"
else
strAction=request("Recalculate")
if straction="" then
straction=Request("REcalculate.x")
end if
if strAction<>"" then
strACTION="RECAL"
end if
end if
end if
if strAction<>"" then
ReprocessForm
else
ProcessNewadd
end if
' new item is to be added to cart
Sub ProcessNewAdd()
Dim rc
ShopInit
GetInputValues
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
if scartitem="" then
responseredirect "shopemptycart.asp"
end if
If scartItem = 0 and prodid="" Then
shoperror getlang("langError01")
End If
If prodid <> "" Then
If scartItem = getconfig("xMaxCartitems") and scartItem>0 then
shoperror getlang("langerror02")
End If
prodi=""
CartInventoryproduct prodid, rc ' see if we are adding sub products
if rc=0 then
CartGetProduct prodid, rc
If rc=0 then
SetSess "newProductPrice",""
GetProductFeatures prodi ' in shopproductfeatures.asp
CartAddItem prodid, rc
else
shoperror getlang("langErrorNoProduct") & "id=" & prodid & "
"
end if
end if
end if
'VP-ASP 6.50 - precautionary security fix
returnurl=cleanchars(request("returnurl"))
if returnurl<>"" then
responseredirect returnurl
end if
DisplayForm
end sub
Sub GetInputValues
' Keys are
' productid = a number in the database
' quantity = a number of items
' db = database to change the database
'
Dim sOption, sUserText, sUserTextvalue
Dim optionnum
Dim maxFeatures
dim sMultiOption, sMultiValue
Dim i
prodid = Request("productid")
if prodid="" then
prodid=request("catalogid")
end if
If not isnumeric(prodid) then
shoperror "Product ID must be numeric"
End if
quantity = Request("quantity")
If Quantity<>"" then
ValidateQuantity quantity
end if
If prodid<>"" and quantity="" then
quantity=1
end if
' There can be up to 4 different features for a product option1, option2
maxfeatures=getconfig("xMaxFeatures")
SetSess "Maxfeatures",maxfeatures
end sub
'
Sub ReprocessForm
dim cartattributes, maxcartitems
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
Select Case strAction
Case "CONTI"
responseredirect ContinueURL
Case "RECAL"
' Response.write "recalculating"
'moved functionality into it's own sub to accomodate for Proceed also - Dean 20/2/2006
recalculate
Case "PROCE"
'call recalculate sub to recalculate quantity on proceed - Dean 20/2/2006
recalculate
if getconfig("xsslshopcustomer") = "Yes" then
responseredirect getconfig("xssl") & "shopcustomer.asp"
else
responseredirect "shopcustomer.asp"
end if
End Select
DisplayForm
End Sub
' Sub display form
Sub DisplayForm()
ShopPageHeader
if getconfig("xbreadcrumbs") = "Yes" then
response.write ""
end if
Response.Write "" & getlang("langcommonviewcart") & "
" & vbCrLf
If Serror<>"" then
shopwriteerror serror
end if
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
FormatFormFields
ShopPageTrailer
end sub
' Format form
Sub FormatFormFields
%>
<%=CartHeaderFont%><%=getlang("langCart01")%> <%=scartitem%><%=CartHeaderEnd%>
"
%>
<%=CartInfoFont%><%=getlang("langCart02")%><%=CartInfoFontEnd%>
<%
if getconfig("xAllowSaveCart")="Yes" Then
Response.write "
" & "" & getlang("langSaveCart") & "" & "
"
End if
if getconfig("xWishlist")="Yes" Then
Response.write "
" & "" & getlang("langwishlist") & "" & "
"
End if
If getconfig("xalsobought")="Yes" then
DisplayAlsoBought
end if
End Sub
Sub CheckStockLevelRecalculate (stocklevel,tquantity, arrcart, scartitem, index, msg)
Dim i
dim lstock
dim totquantity
dim lngid, newlevel
lngid = arrCart(cProductid,index)
lstock=clng(stocklevel)
totquantity=clng(tquantity)
For i = 1 to scartItem
If lngid = arrCart(cProductid,i) then
If i<>index then
Totquantity=arrCart(cQuantity,i) +totquantity
end if
end if
Next
If totquantity>lstock then
'VP-ASP 6.08 - change quantity to amount after recalculate
'newlevel=lstock-totquantity
newlevel=lstock - (totquantity - clng(tquantity))
If newlevel>=1 then
tquantity=newlevel
else
tquantity=arrCart(cQuantity,index)
end if
Msg=Msg & getlang("langStockChanged") & "
" & arrCart(cProductname,index) &"
"
end if
end sub
'*********************************************************************
' Find out where we came from
'*********************************************************************
Sub SetContinueurl (continueurl)
dim pagefrom, words(20),wordcount
pagefrom= request.servervariables("http_referer")
parserecord pagefrom, words, wordcount,"/"
'VP-ASP 6.09 - changed below to be more flexible
'if lcase(words(wordcount-1))<>"shopaddtocart.asp" then
if (instr(lcase(words(wordcount-1)),"shopaddtocart.asp") = 0) AND (instr(lcase(words(wordcount-1)),"shopdeliveryedit.asp") = 0) then
setsess "pagefrom",pagefrom
else
pagefrom=getsess("pagefrom")
if pagefrom="" then
pagefrom=getconfig("xcontinueurl")
end if
end if
continueurl=pagefrom
If getconfig("xdebug")="Yes" then
debugwrite "will return to " & continueurl
end if
end Sub
'Recalculate sub - recalculates a change in quantity
Sub recalculate
cartattributes=cMaxCartAttributes
maxcartitems=getconfig("xmaxcartitems")
newcount=0
ReDim newcart(cartAttributes,maxCartItems)
For i = 1 to scartItem
'VP-ASP 6.50 - fix error with Buy X Get X Free
if instr(lcase(arrcart(cProductName, i)), lcase(Getlang("Langfreeproduct"))) = 0 then
'VP-ASP 6.50 - precautionary security fix
confirm = cleanchars(Request.Form("selected" & CStr(i)))
tquantity = Request.Form("Quantity" & Cstr(i))
if Not isnumeric(tquantity) then
tquantity=1
end if
validatequantity tquantity
Correctminimumquantity tquantity, arrCart(cMinimumquantity,i)
Correctmaximumquantity tquantity, arrCart(cMaximumquantity,i)
stocklevel=arrCart(cStocklevel,i)
If getconfig("XcheckStocklevel")="Yes" Then
If stocklevel<>"" then
CheckStockLevelRecalculate stocklevel,tquantity, arrcart, scartitem, i, msg
end if
end if
arrCart(cQuantity,i)=tquantity
if getconfig("xcartremoveChecked")="Yes" Then
testremove="yes"
else
testremove=""
end if
If confirm <> testremove or tquantity=0 Then
else
newcount=newcount+1
cartattributes=cMaxCartAttributes
for x = 1 to cartAttributes
NewCart(x, newcount) = arrCart(x,i)
next
ProductPrice=Newcart(cOriginalPrice,newcount)
NewCart(cUnitPrice,newcount)=ProductPrice
DiscountPrice=ProductPrice
CalculateUserPrice ProductPrice, tquantity, DiscountPrice, Newcart, Newcount
Newcart(cUnitPrice,newcount)=DiscountPrice
If getconfig("xdualprice")="Yes" and getconfig("Xdualpricefield")<>"" then
Newcart(cDualPrice,newcount) = arrCart(cDualprice,i)
else
Convertcurrency discountPrice, dualreprice
Newcart(cDualPrice,newcount) = dualreprice
end if
end if
'VP-ASP 6.50 - fix error with Buy X Get X Free
else
If confirm <> testremove or tquantity=0 Then
else
newcount=newcount+1
for x = 1 to cartAttributes
NewCart(x, newcount) = arrCart(x,i)
next
end if
end if
Next
SetSess "CartCount", newcount
SetSessA "CartArray", Newcart
arrcart=Newcart
scartitem=newcount
Serror=msg
End sub
%>