<!-- #include file="shop$db.asp" -->
<!-- #include file="shopcartformat.asp" -->
<!-- #include file="shopproductfeatures.asp" -->
<!-- #include file="shopcustomerprices.asp" -->
<%
'************************************************************
' Version 5.0 Jan 21, 2003
' This routine displays the shopping cart and does recalculation
' if returnurl is passed, this routine returns back to that URL
'*******************************************************
Dim prodid, quantity, arrCart, scartItem
Dim strAction,  pi, dualreprice
Dim returnurl
dim ContinueURL
ContinueURL=getconfig("xcontinueshopping")
If getconfig("xcontinueshoppingdynamic")="Yes" then
  Setcontinueurl continueurl
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
   Response.Redirect "shopemptycart.asp"
end if
If scartItem = 0 and prodid="" Then
   Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (getlang("langError01"))
End If
If prodid <> "" Then
    If scartItem = getconfig("xMaxCartitems") and scartItem>0 then
	Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (getlang("langerror02"))
    End If
    CartAddItem prodid, rc
    if rc > 0 then
               sError=getlang("langErrorNoProduct") & "id="  & prodid
    end if 
    returnurl=request("returnurl")
    if returnurl<>"" then
       response.redirect returnurl
    end if   
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
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
prodi=""
prodi=""
If prodid<>"" then
  CartGetProduct prodid, rc
  SetSess "newProductPrice",""
  GetProductFeatures prodi       ' in shopproductfeatures.asp
end if  
end sub
'
Sub ReprocessForm
dim cartattributes, maxcartitems
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
Select Case strAction
Case "CONTI"
     Response.Redirect ContinueURL
  
	
Case "RECAL"
'        Response.write "recalculating"
         dim Newcart
         Dim Newcount
         Dim tquantity
         Dim confirm
         dim testremove
         Dim x
         dim msg, stocklevel
         cartattributes=cMaxCartAttributes
         maxcartitems=getconfig("xmaxcartitems")
         newcount=0
         ReDim newcart(cartAttributes,maxCartItems)
	 For i = 1 to scartItem
	    confirm = 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
                Convertcurrency discountPrice, dualreprice
                Newcart(cDualPrice,newcount) = dualreprice 
              end if
	     Next
	     SetSess "CartCount", newcount
	     SetSessA "CartArray", Newcart
             arrcart=Newcart
             scartitem=newcount
	     Serror=msg       
Case "PROCE"
	Response.Redirect "shopcustomer.asp"

End Select
DisplayForm
End Sub

' Sub display form
Sub DisplayForm()
ShopPageHeader
If Serror<>"" then
   shopwriteerror serror
end if   
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
FormatFormFields
ShopPageTrailer
end sub

' Format form
Sub FormatFormFields
%>
<center>
<%=CartHeaderFont%><%=getlang("langCart01")%> <%=scartitem%><%=CartHeaderEnd%> 
<P>
<FORM action="shopaddtocart.asp" method="POST">
<%
dim allowdelete
allowdelete="TRUE"
CartFormat allowdelete
response.write "<br>"
If Getconfig("xbuttoncontinueshopping")="" Then
%> <INPUT name="continue" type=submit value="<%=getlang("langCart03")%>">&nbsp;<%
else
%><INPUT name="continue" border='0' type=image src="<%=getconfig("xbuttoncontinueshopping")%>">&nbsp;<%
end if
If Getconfig("xbuttonrecalculate")="" Then
%> <INPUT name="recalculate" type=submit value="<%=getlang("langCart04")%>">&nbsp;<%
else
%><INPUT name="recalculate" border='0' type=image src="<%=getconfig("xbuttonrecalculate")%>">&nbsp;<%
end if
If Getconfig("xbuttoncheckout")="" Then
%> <INPUT name="checkout" type=submit value="<%=getlang("langCart05")%>">&nbsp;<%
else
%><INPUT name="checkout" type=image border='0' src="<%=getconfig("xbuttoncheckout")%>">&nbsp;<%
end if
%>
</P></FORM>
<center>
<%=CartInfoFont%><%=getlang("langCart02")%><%=CartInfoFontEnd%>
<%
if getconfig("xAllowSaveCart")="Yes" Then
  Response.write "<br>" & "<a href='shopsavecart.asp'>" & getlang("langSaveCart") & "</a>" &  "<br>"
End if
if getconfig("xWishlist")="Yes" Then
  Response.write "<br>" & "<a href='shopsaveperm.asp'>" & getlang("langwishlist") & "</a>" & "<br>"
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
   newlevel=lstock-totquantity
   If newlevel>=1 then
     tquantity=newlevel
   else
     tquantity=arrCart(cQuantity,index)  
   end if  
   Msg=Msg & getlang("langStockChanged") & "<br>" &  arrCart(cProductname,index) &"<br>"
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,"/"
if lcase(words(wordcount-1))<>"shopaddtocart.asp" 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
%>