<%
Dim DeliveryShippingFlag, DeliveryBasePrice, DeliveryMatch
'
'******************************************************
' VP-ASP 4.00 Dec 10, 2001
' Used when delivery based shipping is specified
'*****************************************************
Sub DeliveryShippingCalc
dim shippingprice, price, deliveryarray, deliverytype
Dim prodid, prodquantity, prodprice
if getconfig("xDeliveryShipping")<>"Yes" then exit sub
'
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
calculationtype=ucase(getconfig("xShippingCalc"))  ' What type of calculation are we doing
if calculationtype<>"LOOKUP" Then
   Shopopendatabase dbc
end if   
Deliverybaseprice=Session("smprice")
If isnumeric(Deliverybaseprice) then
   Deliverybaseprice=csng(DeliveryBasePrice)
else
   DeliveryBasePrice=0
end if
'Debugwrite "Delivery Baseprice=" & Deliverybaseprice
shippingprice=0
DeliveryMatch=0
DeliveryShippingFlag=False
' go through all products
For i = 1 to scartItem
    price=0
    DeliveryArray=arrCart(cDelivery,i)
    prodid=arrCart(cProductid,i)
    Prodquantity=arrCart(cQuantity,i)
    ProdPrice=arrCart(cUnitPrice, i)
    If isarray(deliveryarray) then 
        Deliverytype=Deliveryarray(dDeliveryType)
        If Deliveryarray(dDeliveryType)<>LangDeliverySelf then
        DeliveryMatch=DeliveryMatch+1
        Select Case CalculationType
         Case "LOOKUP"
           DeliverybyLookup price, prodid, prodquantity, prodprice, deliveryarray
         Case "WEIGHT"
            DeliverybyWeight price, prodid, prodquantity, prodprice, deliveryarray
         Case "QUANTITY"
             DeliverybyQuantity price, prodid, prodquantity, prodprice, deliveryarray
         Case "WEIGHTRANGE"
             DeliverybyWeightRange price, prodid, prodquantity, prodprice, deliveryarray
         Case "PRICERANGE"
           DeliverybyPriceRange price, prodid, prodquantity, prodprice, deliveryarray
         Case "QUANTITYRANGE"
			DeliverybyQuantityrange price, prodid, prodquantity, prodprice, deliveryarray 
         end select
         shippingprice=shippingprice+price 
         end if         
     end if    
next
If Deliverymatch<>scartitem then
   shippingprice=shippingprice+DeliveryBasePrice
end if   
SetSess "smprice",shippingprice
if calculationtype<>"LOOKUP" Then
   Shopclosedatabase dbc
end if   
end sub
'
Sub DeliveryByQuantityRange(price, prodid, prodquantity, prodprice, deliveryarray)
'**************************************************************************
' adeecSEpt 21
'**************************************************************************  
Dim Totalquantity
Totalquantity=0
ShopOpenDatabase dbc              ' find
TotalQuantity=prodquantity      ' total quantity of product
If getconfig("XdeliveryAddress")="Yes" and Totalquantity=0 then exit sub
DeliveryLocateShippingQuantityRange shipmethod, TotalQuantity, price
end sub


Sub DeliveryLocateShippingQuantityRange (Shipmethod, TotalQuantity, price)
dim rsitems
dim lowweight, highweight
Dim addprice
Dim Extraweight
Dim ExtraPrice
Dim TotalPrice
SetSess "ShipCalc","Quantity Range"
' Find the quantity range using shipother1 and shipother2
'debugwrite "searching for " & shipmethod & " for weight " & totalweight
SetSess "Shipmethod",Shipmethod
dim shipsql
' Reread database record for a particular method
ShipSql="Select * from shipmethods where Shipmethod='" & shipmethod & "'"
Set rsitems=dbc.execute(shipsql) 
do while not rsitems.eof 
   lowweight=rsitems("shipother1")
   highweight=rsitems("shipother2") 
  'debugwrite "low=" & lowweight & " high=" & highweight
   if not isnull(lowweight) then 
        lowweight=clng(lowweight)
   end if  
   if not isnull(highweight) then 
        highweight=clng(highweight)
   end if  
    if totalquantity >= lowweight and Totalquantity <= highweight then
      shipcost= rsitems("shipbasecost")
   '   Debugwrite "basecost=" & Shipcost 
      Extraweight=totalquantity-Lowweight
      extraprice=rsitems("shipextracost")
      AddPrice=0
      If not isnull(Extraprice) then  
        If Extraweight>0 then
          AddPrice=ExtraWeight*ExtraPrice
        end if
      end if
      TotalPrice=ShipCost+AddPrice  
		Price= Price + TotalPrice
      rsitems.close
      ShopCloseDatabase dbc
     'debugwrite "Total=" & totalprice & " AddPrice=" & addprice  
      exit sub 
   end if 
   rsitems.movenext   
loop
Price=99999.99
rsitems.close
ShopCloseDatabase dbc
end sub


Sub  DeliverybyLookup (price, prodid, prodquantity, prodprice, deliveryarray)
price=Deliverybaseprice
end sub

Sub  DeliverybyWeight (price, prodid, prodquantity, prodprice, deliveryarray)
Dim weight, totalprice, shipcost, rs, sql
weight=0
sql="Select weight from products where catalogid=" & prodid
set rs=dbc.execute(sql)
if not rs.eof then
   weight=rs("Weight")
   if not isnull(weight) then
      weight=weight*prodquantity
   end if
end if
rs.close
set rs=nothing
TotalPrice=0
If not isnull(curshipbaseCost) then
   TotalPrice=curShipBaseCost
end if
ShipCost=CurShipExtraCost
Price = Weight* prodquantity * ShipCost
Price= Price + TotalPrice
end sub

Sub  DeliverybyQuantity (price, prodid, prodquantity, prodprice, deliveryarray)
'**************************************************************************
' Use number of items as shipping calculation
' QuantityBase = base shipping Price
' QuantityExtra= Extra amount per item
'**************************************************************************  
Dim ShippingPrice
Dim TotalPrice
Dim QuantityExtra
TotalPrice=0           ' from database 
'debugwrite "shipmethod=" & shipmethod
QuantityExtra=curShipExtracost    ' extra per unit 
If isnull(QuantityExtra) then
    QuantityExtra=0
end if
TotalPrice=curShipBaseCost          ' base amount
ShippingPrice = prodquantity * QuantityExtra
Price= ShippingPrice + TotalPrice
end sub

Sub DeliveryByPriceRange (price, prodid, prodquantity, prodprice, deliveryarray)
'**************************************************************************
' Use numer of items as shipping calculation
' Calculate fill Price
'**************************************************************************  
Dim weight
Dim i
Dim ShippingPrice
Dim TotalPrice
Dim rsitem
Dim ShippingCost
dim rsitems
dim lowvalue, highvalue
dim shipsql
totalprice=Prodprice*Prodquantity
shipsql="select * from shipmethods where shipmethod='" & shipmethod & "'"
Set rsitems=dbc.execute(shipsql) 
do while not rsitems.eof 
   Lowvalue=rsitems("ShipCost1")
   Highvalue=rsitems("shipCost2") 
  ' debugwrite "low=" & lowvalue & " high=" & highvalue
   if totalPrice >= lowvalue and TotalPrice < highvalue then
      ShipCost= rsitems("ShipBaseCost")
      rsitems.close
      set rsitems=nothing
      price=ShipCost
      exit sub 
   end if 
   rsitems.movenext   
loop
ShipCost=0
rsitems.close
set rsitems=nothing
end sub

Sub DeliveryByWeightRange( price, prodid, prodquantity, prodprice, deliveryarray)
dim sql, rs
Dim weight
Dim TotalWeight
TotalWeight=0
Price=0 
sql="Select weight from products where catalogid=" & prodid
set rs=dbc.execute(sql)
if not rs.eof then
   totalweight=rs("weight")
   if not isnull(totalweight) then
      totalweight=totalweight*prodquantity
   end if
end if
rs.close
set rs=nothing
LocateDeliveryWeightRange price, shipmethod, TotalWeight
'Debugwrite "weightprice=" & price & "totalweight=" & totalweight
end sub

Sub LocateDeliveryWeightRange (Totalprice, Shipmethod, Totalweight)
dim rsitems
dim lowweight, highweight
Dim addprice
Dim Extraweight
Dim ExtraPrice
SetSess "ShipCalc","Weight Range"
dim shipsql
' Reread database record for a particular method
ShipSql="Select * from shipmethods where Shipmethod='" & shipmethod & "'"
Set rsitems=dbc.execute(shipsql) 
do while not rsitems.eof 
   lowweight=rsitems("shipother1")
   highweight=rsitems("shipother2") 
   'debugwrite "low=" & lowweight & " high=" & highweight
   if not isnull(lowweight) then 
        lowweight=clng(lowweight)
   end if  
   if not isnull(highweight) then 
        highweight=clng(highweight)
   end if  
    if totalweight >= lowweight and Totalweight <= highweight then
      ShipCost= rsitems("ShipBaseCost")
   '   Debugwrite "basecost=" & Shipcost 
      Extraweight=totalweight-Lowweight
      extraprice=rsitems("shipextracost")
      AddPrice=0
      If not isnull(Extraprice) then  
        If Extraweight>0 then
          AddPrice=ExtraWeight*ExtraPrice
        end if
      end if
      TotalPrice=ShipCost+AddPrice  
      rsitems.close
  '    debugwrite "Total=" & totalprice & " AddPrice=" & addprice  
      exit sub 
   end if 
   rsitems.movenext   
loop
rsitems.close
set rsitems=nothing
end sub
%>