<%
Dim ShipMethod
Dim ShipCost
Dim ShippingMethods(50)
'------------
' VP-ASP 6.00 - Nov 12,2005
'------------
Dim shippingvalues(50), tempvalue
'------------
Dim ShippingCount
Dim CalculationType
dim upsdbc
dim shiptotalWeight,shiptotalfeatureweight, shiptotalcost, shiptotalquantity
const productcostfield="weight"   ' set to other field if necessary
const shipcountrydefault="other"  ' set for other country   
'**********************************************************************
' Version 6.50
' Const xShippingCalc="Lookup"   fixed price lookup in database+delivery
' Const xShippingCalc="Weight"    Calculate by weight + delivery
' Const xShippingCalc="Quantity"  Calculate by Quantity
' Const xShippingCalc="WeightRange" 'lookup total weight+ delivery
' Const xShippingCalc="PriceRange"  ' lookup by price range +delivery
' Const xShippingCalc="Product"    ' shipping is unique to product(weight field has value) 
' Const xShippingCalc="Fixed" 
' const xshippingcalc="Other"      ' ' other requires shiproutine to be filled in 
' const xshippingcalc="QuantityRange"      ' ' other requires shiproutine to be filled in 
' Const xShippingcalc="Message"
' Const xShippingcalc="PricePercent"   ' percentage of product total                  
' Free shipping over a certain amount
' Country based shipping
' Jan 1, 2005                   fix shipping values
'*********************************************************************
'
Sub UpdateShippingSessionData()
' called from shop customer to process form and get shipping price
Dim optionname
Dim optionPrice
dim rc
SetSess "shipname", strshipname
SetSess "shipcompany", strshipcompany
SetSess "shipaddress", strshipaddress
SetSess "shiptown", strshiptown
SetSess "shipzip", strshipzip
SetSess "shipstate", strshipstate
SetSess "shipcountry", strshipcountry
Setsess "shipmessage",""

'VPASP 6.09 Security Fix
ShipMethodType=cleanchars(Request.form("ShipMethodType"))
	
    if shipmethodtype="" then
       shipmethodtype=getconfig("xfixedshippingmethod")
    end if   
    SetSess("Shipmethodtype"),Shipmethodtype
    ParseOption ShipMethodType, ShipMethod, ShipCost
    debugwrite "shipmethodtype="& shipmethod & "shipcost=" & shipcost
    SetSess "ShipMethod",Shipmethod
    If getconfig("Xcurrencysymbol")<>"" and Shipcost<>"" then
       shipcost=replace(shipcost,getconfig("xcurrencysymbol"),"")
    end if   
    SetSess "smprice",ShipCost
    HandleFreeShipping rc
    if rc=0 then
       exit sub
    end if    

	'---------------
	' VP-ASP 600 - Handle Other shipping
	' 20/10/2005
	'---------------
	dim othershipsql, othershiprs
	othershipsql="Select * from shipmethods where shipmethod='" & shipmethod & "'"
	ShopOpendatabase dbc
	AddShippingCountry othershipsql,othershiprs, dbc

	If not othershiprs.eof then 
		if othershiprs("shiproutine") > "" then
			SetSess "ShipCalc","OTHER"
			Setsess "followonURL",othershiprs("shiproutine")
			othershiprs.close
			set othershiprs=nothing
			ShopCloseDatabase dbc
			exit sub
		end if
	end if
	othershiprs.close
	set othershiprs=nothing
	ShopCloseDatabase dbc
	'---------------

    If ucase(getconfig("xshippingCalc"))="LOOKUP" then
         SetSess "ShipCalc","LOOKUP"
         DeliveryShippingCalc
         exit sub
    end if 
CalculateShipping    ' all others handled differently
if getconfig("xDeliveryShipping")="Yes" then 
  DeliveryShippingCalc    ' handle delivery shipping
end if  
end sub
'

Sub CalculateShipping
dim shipconn
' Save all the other routines the trouble by recalculating cost, weight, weight
shopopendatabase  shipconn
LocateShippingRecord shipconn, Shipmethod     ' get shipping record
CalculateShippingdetails shipconn,shiptotalWeight,shiptotalfeatureweight, shiptotalcost, shiptotalquantity
shopclosedatabase shipconn
'
Calculationtype=ucase(getconfig("xShippingCalc"))  ' What type of calculation are we doing
If Calculationtype="" then exit sub
'debugwrite "calc=" & calculationtype
Select Case CalculationType
     Case "WEIGHT"
         HandlebyWeight
     Case "QUANTITY"
         HandlebyQuantity
     Case "WEIGHTRANGE"
         HandlebyWeightRange
     Case "PRICERANGE"
         HandlebyPriceRange
     Case "FIXED"
         HandlebyFixed
     Case "PRODUCT"
         HandlebyProduct
     Case "QUANTITYRANGE"
         HandlebyQuantityrange
     Case "MESSAGE"
         HandlebyMessage    
     Case "OTHER"
         HandlebyOther
      Case "PRICEPERCENT"
         HandlebyPricePercent    
     Case else
          Serror="Unknown Shipping Method"
end select          
end sub

Sub GetShippingDatabase
'***************************************************
' Read database and store dat in shippingmethods array
' because of curreny conversion there are two arrays
' shippingmethods is the display portion in current currency
' shippingvalues is the original price
'*************************************************
Dim rsship
Dim dbc
Dim TempOption, tempdisplay, tempvalue
Dim TempPrice
dim prevMethod
shippingcount=0
prevmethod=""
ShopOpenDatabase dbc
Set rsship = Server.CreateObject ("ADODB.Recordset")
SQL="Select * from shipmethods order by shipmethod"
rsship.Open SQL, dbc, adOpenForwardOnly,adLockReadOnly, adCmdText
Do While Not rsship.EOF
	TempOption = ""
	TempValue = ""
	TempPrice = ""
    TempOption = rsship("shipmethod")
    TempPrice=rsship("smprice")
    Tempdisplay=tempoption
    tempvalue=tempoption
    if TempOption<>PrevMethod then
      If getconfig("xdisplayprices")="No" then
        TempPrice=""
      end if    
      if TempPrice<>"" then
        if TempPrice<>0 then
	   TempDisplay= TempOption & " [" & shopformatcurrency(TempPrice,getconfig("xdecimalpoint")) & "]"
	   TempValue= TempOption & " [" & formatnumber(TempPrice,getconfig("xdecimalpoint")) & "]"
        end if
      end if
       ShippingMethods(shippingcount)=TempDisplay
       shippingvalues(shippingcount) =Tempvalue
     end if  
     PrevMethod=TempOption
     If ShippingCount=0 then
         If GetSess("Shipmethodtype")<>"" then
             shipmethodtype=Getsess("shipmethodtype")
         else    
            ShipMethodType=ShippingMethods(0) ' set defaut method
         end if   
     end if
     shippingcount=shippingcount+1
     rsship.MoveNext 
Loop
closerecordset rsship
ShopCloseDatabase dbc
end sub

'*************************************************
Sub LocateShippingRecord (dbc,Shipmethod)
'**************************************************
' gets one shipping method from database
dim shipsql
Dim i
' Reread database record for a particular method
shipsql="select * from shipmethods where shipmethod='" & shipmethod & "'"
AddShippingCountry shipsql, objrs, dbc
If objRS.EOF Then
	'VP-ASP 6.09 - fix for shipping displaying error inappropriately
	select case ucase(getconfig("xshippingcalc"))
	case "FIXED"
		cursmprice = shopformatcurrency(getconfig("xfixedshippingcost"), getconfig("xdecimalpoint"))
		Shipmethod = ucase(getconfig("xshippingcalc")) & " " & cursmprice
        ShipCost=curSmprice
		setsess "shipmessage",shipmethod
	case "PRODUCT"
		Shipmethod = ""
		setsess "shipmessage",shipmethod
	case else
     Shipmethod = "Cannot locate shipping record<br />"'  & shipsql
     setsess "shipmessage",shipmethod
	 end select
Else
        lngshipmethodid = objrs("shipmethodid")
	strshipmethod = objrs("shipmethod")
	cursmprice = objrs("smprice")
        curshipbasecost = objrs("shipbasecost")
	curshipextracost = objrs("shipextracost")
        if isnull(curshipbasecost) then
           curshipbasecost=0
        end if
        if isnull(curshipextracost) then
           curshipextracost=0
        end if
	strshipother1 = objrs("shipother1")
	strshipother2 = objrs("shipother2")
	curshipcost2 = objrs("shipcost2")
	curshipcost1 = objrs("shipcost1")
        ShipCost=curSmprice
End If
closerecordset objrs
End Sub
'
Sub HandleByWeight
'**************************************************************************
' ShipMethod. Get total weight
' Base Cost + extracost*weight
'
'**************************************************************************  
dim prodid, prodcode, prodname, Prodquantity, ProdPrice
Dim weight
Dim i
Dim ShippingPrice
Dim TotalPrice
Dim ShippingCost
If shiptotalweight=0 then 
    Setsess "smprice",0
    exit sub
end if
TotalPrice=0
If not isnull(curshipbaseCost) then
   TotalPrice=curShipBaseCost
end if
ShipCost=CurShipExtraCost
ShippingPrice = shipTotalWeight* ShipCost
TotalPrice= ShippingPrice + TotalPrice
SetSess "smprice",TotalPrice
SetSess "ShipMethod",ShipMethod
SetSess "shipcalc","Weight"
end sub

Sub HandleByProduct
'**************************************************************************
' ShipMethod
' ShipCost 
' The weight field in the database actually has product shipping cost
'**************************************************************************  
Dim rssql
Dim i
Dim ShippingPrice
Dim TotalPrice
Dim rsitem
Dim ShippingCost
Dim Prodid, prodquantity
ShopOpenDatabase dbc
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
' go through all products
For i = 1 to scartItem
    prodid=arrCart(cProductid,i)
    Prodquantity=arrCart(cQuantity,i)
    rssql="Select * from products where catalogid=" & prodid
    If getconfig("xshippingfreeproducts")="Yes" then
       rssql=rssql &  " and (freeshipping=0 or freeshipping is null)"
    end if   
    set rsitem=dbc.execute(rssql)
    If Not rsItem.EOF Then
        shippingcost=rsitem(ProductCostField)
        if isNull(shippingcost) then
            shippingcost=0
        end if
         ShippingPrice = shippingcost* prodquantity 
         TotalPrice= ShippingPrice + TotalPrice
         If getconfig("xdebug")="Yes" then 
           Debugwrite "ShippingPerItem=" & ShippingCost & " quantity=" & prodquantity
           Debugwrite "shippingPrice=" & ShippingPrice
          debugwrite "total=" & Totalprice 
        end if 
    end if
    rsitem.close
    set rsitem=nothing 
Next
ShopCloseDatabase  dbc
SetSess "smprice",TotalPrice
end sub
'
Sub HandleByQuantity
'**************************************************************************
' Use number of items as shipping calculation
' QuantityBase = base shipping Price
' QuantityExtra= Extra amount per item
'**************************************************************************  
dim prodid, prodcode, prodname, Prodquantity, ProdPrice
Dim i, calculate
Dim ShippingPrice
Dim TotalPrice
dim prodconn
Dim QuantityExtra, DEliveryArray
If shiptotalquantity=0 then 
   setsess "smprice",0
   exit sub
end if   
TotalPrice=0           ' from database 
'debugwrite "shipmethod=" & shipmethod
QuantityExtra=curShipExtracost    ' extra per unit 
If isnull(QuantityExtra) then
    QuantityExtra=0
end if
shopopendatabaseP prodconn
TotalPrice=curShipBaseCost          ' base amount
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
' go through all products
For i = 1 to scartItem
    Calculate=True
    prodid=arrCart(cProductid,i)
    prodcode=arrCart(cProductCode,i)
    prodname= arrCart(cProductname,i)
    Prodquantity=arrCart(cQuantity,i)
    ProdPrice=arrCart(cUnitPrice, i)
    Deliveryarray=arrcart(cDelivery,i)
    Calculate=CheckDeliverySelf(deliveryArray)
    If calculate=True then 
       Calculate=CheckDeliveryFree(prodconn, prodid)
       If calculate=True then 
        ' Debugwrite "prodid=" & prodid  & " quantity=" & prodquantity
         ShippingPrice = prodquantity * QuantityExtra
         TotalPrice= ShippingPrice + TotalPrice
       end if  
    end if
    If getconfig("xdebug")="Yes" then
      Debugwrite "ExtraPerItem=" & QuantityExtra & " quantity=" & prodquantity
      Debugwrite "shippingPrice=" & ShippingPrice
      debugwrite "total=" & Totalprice 
    end if
Next
SetSess "smprice",TotalPrice
SetSess "ShipMethod",ShipMethod
SetSess "shipcalc","Quantity"
end sub

Sub HandleByPriceRange
'**************************************************************************
' 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
'
If shiptotalcost=0 then 
    setsess "smprice",0
    exit sub
end if    
TotalPrice=shiptotalcost
ShopOpenDatabase dbc
If getconfig("Xdeliveryshipping")="Yes"  then 
   CalculateTotalPrice dbc,totalprice
   If totalprice=0 then 
       shopclosedatabase dbc
      exit sub
   end if   
end if   
              ' find
' Find the weight range using shipother1 and shipother2
'debugwrite "searching for " & shipmethod & " for Price " & totalPrice
' Reread database record for a particular method
shipsql="select * from shipmethods where shipmethod='" & shipmethod & "'"
AddShippingCountry shipsql,rsitems, dbc
shipsql=shipsql & " order by shipcost1"
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")
      closerecordset rsitems
      ShopCloseDatabase dbc
      SetSess "smprice",ShipCost
      exit sub 
   end if 
   rsitems.movenext   
loop
ShipCost=0
closerecordset rsitems
ShopCloseDatabase dbc
SetSess "smprice",ShipCost
SetSess "ShipCalc","Price Range"
end sub

Sub HandleByWeightRange
'**************************************************************************
' Use numer of items as shipping calculation
'  Calculate weight on product id
' If shipother1 set then use extra when weight exceeds
'  Shipother1=LowWeight Range
'  ShipOther2=highweightrange
'  ShipBasecost=cost in that range
'  Shipextracost  if weight exceeds low range
'  
'  shipmethod	smprice	ShipBaseCost	ShipExtraCost	ShipOther1   ShipOther2	
'  GROUND		$8.50	        $2.00	          0   		100	
'  2nd DAY AIR		$18.50	        $3.00	          2			
'  Next Day Air		$35.50	        $3.50	          2			
'  International	$49.50	        $9.00	          2			
'**************************************************************************  
Dim weight
Dim i
Dim ShippingPrice
Dim TotalPrice
Dim rsitem
Dim ShippingCost
Dim TotalWeight
dim totalfeatureweight
TotalWeight=0
TotalPrice=0             ' set base price from database or a constant
If getconfig("XdeliveryAddress")="Yes" and shipTotalweight=0 then exit sub
totalweight=shiptotalweight
LocateShippingWeightRange shipmethod, TotalWeight
end sub
'****************************************************************
' read all records with specific ship method name
' See which falls into weight range calculation
'*****************************************************************
Sub LocateShippingWeightRange (Shipmethod, Totalweight)
dim rsitems
dim lowweight, highweight
Dim addprice
Dim Extraweight
Dim ExtraPrice
Dim TotalPrice
shopopendatabase dbc
SetSess "ShipCalc","Weight Range"
' Find the weight 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 & "'"
AddShippingCountry shipsql,rsitems, dbc
'debugwrite "shipsql=" & shipsql
do while not rsitems.eof 
   lowweight=rsitems("shipother1")
   highweight=rsitems("shipother2") 
  'debugwrite "low=" & lowweight & " high=" & highweight
   if not isnull(lowweight) then 
        lowweight=csng(lowweight)
   end if  
   if not isnull(highweight) then 
        highweight=csng(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
      set rsitems=nothing
      ShopCloseDatabase dbc
      SetSess "smprice",TotalPrice
  '    debugwrite "Total=" & totalprice & " AddPrice=" & addprice  
      exit sub 
   end if 
   rsitems.movenext   
loop
ShipCost=99999.99
rsitems.close
set rsitems=nothing
ShopCloseDatabase dbc
SetSess "smprice",ShipCost
setsess "shipselectionerror", "weight"
' shipsql
end sub
'************************************************************************
' if therte is no quantity then even fixed has no cost
'************************************************************************
Sub HandleByFixed
' Need to add xshippingmethod and xshipping cost to shop$config for this to work
if shiptotalquantity=0 then
   setsess "smprice",0
   exit sub
end if      
ShipMethod=getconfig("xFixedShippingMethod")
SetSess "smprice",getconfig("xFixedShippingCost")
SetSess "ShipMethod",getconfig("xFixedShippingMethod")
end sub


Sub HandlebyOther
'*******************************************************************
' This allows a totally extendable shipping system by allowing the
' routine to be specified in the database
'******************************************************************
dim ShipSql, shipmethod, shiprs, routine
If shiptotalquantity=0 then
   setsess "smprice",0
   exit sub
end if   
shipmethod=Getsess("shipmethod")
shipsql="Select * from shipmethods where shipmethod='" & shipmethod & "'"
ShopOpendatabase dbc
AddShippingCountry shipsql,shiprs, dbc
If not shiprs.eof then 
  routine=shiprs("shiproutine")
  if not isnull(routine) then
    Setsess "followonURL",routine
  end if
end if  
' no routine name treat as lookup
shiprs.close
set shiprs=nothing
ShopCloseDatabase dbc
end sub

Sub CalculateTotalPrice(conn,TotalPrice)
dim Prodquantity, ProdPrice, deliveryarray, i, price, prodid
Dim scartiten, arrcart
scartItem = GetSess("CartCount")
arrCart =   GetSessA("CartArray")
dim Calculate
' go through all products
totalprice=0
For i = 1 to scartItem
    calculate=True
    Prodquantity=arrCart(cQuantity,i)
    ProdPrice=arrCart(cUnitPrice, i)
    DeliveryArray=arrCart(cDelivery,i)
    prodid=arrCart(cProductid,i)
    Calculate=CheckDeliverySelf(deliveryArray)
    If Calculate=True then
       calculate=CheckDeliveryfree (conn, prodid)
       if calculate=true then  
         Price=ProdPrice*ProdQuantity
         totalprice=totalprice+price
       end if  
    end if 
Next
'debugwrite "totalPrice=" & totalPrice
end sub

Function CheckDeliverySelf (deliveryArray)
' Returns tru if to calculate this product
Dim DeliveryType
CheckDeliverySelf=True
If getconfig("Xdeliveryshipping")<>"Yes" then exit function
If isarray(deliveryarray) then
   Deliverytype=Deliveryarray(dDeliveryType)
   If Deliveryarray(dDeliveryType)<>getlang("LangDeliverySelf") then
      CheckDeliverySelf=False
   end if
end  if
end function

Sub HandleByQuantityRange
'**************************************************************************
' Quantity range calculation
'************************************************************************  
Dim Totalquantity
Totalquantity=0
'debugwrite "totalquantity=" & totalquantity
If shiptotalquantity=0 then exit sub
ShopOpenDatabase dbc              ' find
GetProductQuantity TotalQuantity      ' total weight of product
'debugwrite "totalquantity=" & totalquantity
If Totalquantity=0 then exit sub
LocateShippingQuantityRange shipmethod, totalQuantity
end sub

Sub GetProductQuantity( TotalQuantity )
dim scartitem, arrcart,i, prodquantity, deliveryarray, calculate
dim prodprice,Deliverytype
totalquantity=0
scartItem = GetSess("CartCount")
arrCart =   GetSessA("CartArray")
' go through all products
For i = 1 to scartItem
    Calculate=True
    Prodquantity=arrCart(cQuantity,i)
    ProdPrice=arrCart(cUnitPrice, i)
    DeliveryArray=arrCart(cDelivery, i)
    If getconfig("Xdeliveryshipping")="Yes"  and isarray(deliveryarray) then
       Deliverytype=Deliveryarray(dDeliveryType)
       If Deliveryarray(dDeliveryType)<>getlang("LangDeliverySelf") then
          Calculate=False
       end if
    end  if
    If calculate=True then
      totalquantity=totalquantity+prodquantity
    end if 
Next
end sub 

Sub LocateShippingQuantityRange (Shipmethod, TotalQuantity)
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 quantity " & totalquantity
SetSess "Shipmethod",Shipmethod
dim shipsql
' Reread database record for a particular method
shipsql="select * from shipmethods where shipmethod='" & shipmethod & "'"
AddShippingCountry shipsql,rsitems,dbc
do while not rsitems.eof 
   lowweight=rsitems("shipother1")
   highweight=rsitems("shipother2") 
 '  debugwrite "low=" & lowweight & " high=" & highweight
   if not isnull(lowweight) then 
        lowweight=csng(lowweight)
   end if  
   if not isnull(highweight) then 
        highweight=csng(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  
      closerecordset rsitems
      ShopCloseDatabase dbc
      SetSess "smprice",TotalPrice
  '    debugwrite "Total=" & totalprice & " AddPrice=" & addprice  
      exit sub 
   end if 
   rsitems.movenext   
loop
ShipCost=99999.97
closerecordset rsitems
ShopCloseDatabase dbc
SetSess "smprice",ShipCost
setsess "shipselectionerror", "quantity"
'HandleShippingError shipsql
end sub
'
Sub GetProductRecord (dbc, rsitem, prodid)
dim shipsql
ShipSql="Select * from products where catalogid=" & prodid
Set rsitem = dbc.Execute(shipsql)
end sub

'****************************************************************
' a shipping message is to be displayed
'*****************************************************************
Sub HandleByMessage
setsess "smprice",0
setsess "shipmessage",getlang("LangShippingMessage")
end sub
'****************************************************************
' a shipping message is to be displayed
'*****************************************************************
Sub HandleFreeShipping (rc)
dim shipcost, productcost, shipconn
rc=4
If getconfig("xshippingfree")<>"" then 
  shipcost=getconfig("xshippingfree")
  if isnumeric(shipcost) then 
    shipcost=csng(shipcost)
    productcost=getsess("orderproducttotal")
    productcost=csng(productcost)
    If productcost>=shipcost then
      setsess "smprice",0
      setsess "shipmessage",Getlang("LangFreeShippingMessage")
      rc=0
      exit sub
    end if
  end if     
end if
If getconfig("xshippingfreeproducts")="Yes" then
   shopopendatabaseP  shipconn
   CalculateShippingdetails shipconn,shiptotalWeight,shiptotalfeatureweight, shiptotalcost, shiptotalquantity
   shopclosedatabase shipconn
   if shiptotalcost=0  then 
     setsess "smprice",0
     rc=0
     exit sub
   end if
end if   
end sub

'********************************************************************
' if doing country shipping then add country to supplied sql
' if we do not find any records, try using a default shipicountry of other
'***********************************************************************
Sub AddShippingCountry (shipsql, rs, dbc)
dim shipcountry, tempsql
tempsql=shipsql
If getconfig("xshippingbycountry")="Yes" then
  shipcountry=getsess("shipcountry")
  if shipcountry="" then
    shipcountry=getsess("country")
  end if
  if shipcountry<>"" then
    tempsql=shipsql & " and shipcountry='" & shipcountry & "'" 
  end if  
end if    
set rs=dbc.execute(tempsql)
if not rs.eof then exit sub
closerecordset rs
tempsql=shipsql & " and shipcountry='" & shipcountrydefault & "'" 
set rs=dbc.execute(tempsql)
If rs.eof then 
   HandleShippingError tempsql
end if   
end sub  

Sub HandleShippingError (shipsql)
dim shipmethod
Shipmethod = "Cannot locate shipping record<br />"  & shipsql
setsess "shipmessage",shipmethod
setsess "shipselectionerror", "country"
end sub


Sub HandleByPricePercent
'**************************************************************************
' xfixedshippingcost is used as a percent value

'**************************************************************************  
Dim TotalPrice, percent, shippingcost
TotalPrice=GetSess("OrderProductTotal")
percent=getconfig("xFixedShippingCost")
If not isnumeric(percent) then exit sub
percent=csng(percent)
shippingcost=totalprice*percent
shippingcost=formatnumber(shippingcost,2)
setsess "smprice",shippingcost
end sub


%>