<%
'*************************************************************************
' DO NOT MODIFY THIS SCRIPT IF YOU WANT UPDATES TO WORK!
' Function : Basic shipping calculation routines
' Product  : CandyPress Store Frontend
' Version  : 2.5
' Modified : February 2004
' Copyright: Copyright (C) 2004 CandyPress.Com 
'            See "license.txt" for this product for details regarding 
'            licensing, usage, disclaimers, distribution and general 
'            copyright requirements. If you don't have a copy of this 
'            file, you may request one at webmaster@candypress.com
'*************************************************************************

'*************************************************************************
'Variables
'*************************************************************************

'Shipping rate array
dim shipArray
redim shipArray(100,1)

'Totals for items that require shipping
dim totalShipPrice
dim totalShipWeight
dim totalShipItems

'*************************************************************************
'Calculate Totals that will be used to calculate shipping rates
'*************************************************************************
sub calcShipTotals(idOrder)

	'Variables
	dim mySQL, rsTemp
	
	'Initialise
	totalShipPrice	= 0
	totalShipWeight	= 0
	totalShipItems  = 0
	
	'Determine totals
	mySQL="SELECT a.idCartRow, a.quantity " _
		& "FROM   cartRows a, products b " _
		& "WHERE  a.idOrder = " & validSQL(idOrder,"I") & " " _
		& "AND    b.idProduct = a.idProduct " _
		& "AND   (b.noShipCharge IS NULL " _
		& "OR     b.noShipCharge <> 'Y') "
	set rsTemp = openRSexecute(mySQL)
	do while not rsTemp.EOF
		totalShipPrice  = Cdbl(totalShipPrice  + cartTotal(idOrder,rsTemp("idCartRow")))
		totalShipWeight = Cdbl(totalShipWeight + cartRowWeight(idOrder,rsTemp("idCartRow")))
		totalShipItems  = Cdbl(totalShipItems  + rsTemp("quantity"))
		rsTemp.MoveNext
	loop
	call closeRS(rsTemp)

end sub

'*************************************************************************
'Calculate Cart Row Weight
'*************************************************************************
function cartRowWeight(idOrder,idCartRow)
	dim mySQL, rsTemp, quantity, unitWeight, optionWeight
	cartRowWeight = CDbl(0)
	mySQL = "SELECT quantity, unitWeight, " _
		  & "      (SELECT SUM(optionWeight) " _
		  & "       FROM   cartRowsOptions " _
		  & "       WHERE  cartRowsOptions.idCartRow = cartRows.idCartRow) " _
		  & "       AS     optionWeight " _
		  & "FROM   cartRows " _
		  & "WHERE  idOrder   = " & validSQL(idOrder,"I") & " " _
		  & "AND    idCartRow = " & validSQL(idCartRow,"I") & " "
	set rsTemp = openRSexecute(mySQL)
	do while not rsTemp.eof
		quantity      = CDbl(emptyString(rsTemp("quantity"),"0"))
		unitWeight    = CDbl(emptyString(rsTemp("unitWeight"),"0"))
		optionWeight  = CDbl(emptyString(rsTemp("optionWeight"),"0"))
		cartRowWeight = cartRowWeight + (quantity * (unitWeight + optionWeight))
		rsTemp.movenext
	loop
	call closeRS(rsTemp)
end function

'******************************************************************
'Calculate Store Rates
'******************************************************************
sub calcStoreRates(cartSubTotal, cartWeight, locShipZone)

	'Variables
	dim addAmt, addPerc, shipDesc, f
	dim mySQL, rsTemp
	
	'Initialize Counter
	f = 0

	'Get shipping rate records
	mySQL="SELECT a.addAmt,a.addPerc,b.shipDesc " _
	    & "FROM   shipRates a, shipMethod b " _
	    & "WHERE  a.idShipMethod = b.idShipMethod " _ 
	    & "AND    b.status = 'A' " _
	    & "AND    locShipZone = " & validSQL(locShipZone,"I") & " " _
	    & "AND   (addAmt IS NOT NULL OR addPerc IS NOT NULL) " _
	    & "AND  ((unitType='P' AND unitsFrom <= " & validSQL(cartSubTotal,"D") & " AND unitsTo >= " & validSQL(cartSubTotal,"D") & ") " _
	    & "OR    (unitType='W' AND unitsFrom <= " & validSQL(cartWeight,"D")   & " AND unitsTo >= " & validSQL(cartWeight,"D")   & ")) " _
	    & "ORDER BY a.idShipMethod " 
	set rsTemp = openRSexecute(mySQL)
	do while not rsTemp.eof

		'Get values from recordset
		addAmt   = rsTemp("addAmt")
		addPerc  = rsTemp("addPerc")
		shipDesc = trim(rsTemp("shipDesc")&"")

		'Calculate shipping based on fixed amount or percentage of 
		'order total (whichever is the greater value).
		if IsNull(addAmt) then
			addAmt = Round(((cartSubTotal * addPerc) / 100),2)
		else
			if not IsNull(addPerc) then
				if addAmt < ((cartSubTotal * addPerc) / 100) then
					addAmt = Round(((cartSubTotal * addPerc) / 100),2)
				end if
			end if
		end if
			
		'Move values into array, whilst making sure that we move 
		'the largest amount for each shipping method group.
		if f = 0 then '1st position in the array
			shipArray(f,0) = addAmt
			shipArray(f,1) = shipDesc
			f = f + 1
		else
			if lCase(shipDesc) = lCase(shipArray(f-1,1)) then
				if  shipArray(f-1,0) < addAmt then
					shipArray(f-1,0) = addAmt
				end if
			else
				shipArray(f,0) = addAmt
				shipArray(f,1) = shipDesc
				f = f + 1
			end if
		end if
		
		'Read next record
		rsTemp.movenext
			
	loop
	call closeRS(rsTemp)
	
end sub

'******************************************************************
'Calculate Online Rates
'******************************************************************
sub calcOnlineRates(totalShipWeight,shippingLocCountry,shippingLocState,shippingZip)

	'Variables
	dim UPSactive,UPSAccessID,UPSUserID,UPSPassword,UPSfromZip,UPSfromCntry,UPSpickupType,UPSpackType,UPSshipCode,UPSweightUnit,UPSallRates,UPSaddrType
	dim USPSactive,USPSUserID,USPSPassword,USPSfromZip,USPSservice,USPSintNtl,USPSsize,USPSmachinable
	dim CPactive,CPmerchantID,CPfromZip,CPsizeL,CPsizeW,CPsizeH
	dim shipParms
	dim shippingLocCountryDesc
	dim mySQL, rsTemp
	
	'Read parms
	mySQL = "SELECT configVar, configVal " _
		  & "FROM   storeAdmin " _
		  & "WHERE  adminType = 'S'"
	set rsTemp = openRSexecute(mySQL)
	do while not rsTemp.EOF
		select case trim(lCase(rsTemp("configVar")))
		
		'UPS
		case lCase("UPSactive")
			UPSactive			= rsTemp("configVal")
		case lCase("UPSAccessID")
			UPSAccessID			= rsTemp("configVal")
		case lCase("UPSUserID")
			UPSUserID			= rsTemp("configVal")
		case lCase("UPSPassword")
			UPSPassword			= rsTemp("configVal")
		case lCase("UPSfromZip")
			UPSfromZip			= rsTemp("configVal")
		case lCase("UPSfromCntry")
			UPSfromCntry		= rsTemp("configVal")
		case lCase("UPSpickupType")
			UPSpickupType		= rsTemp("configVal")
		case lCase("UPSpackType")
			UPSpackType			= rsTemp("configVal")
		case lCase("UPSshipCode")
			UPSshipCode			= rsTemp("configVal")
		case lCase("UPSweightUnit")
			UPSweightUnit		= rsTemp("configVal")
		case lCase("UPSallRates")
			UPSallRates			= rsTemp("configVal")
		case lCase("UPSaddrType")
			UPSaddrType			= rsTemp("configVal")
			
		'USPS
		case lCase("USPSactive")
			USPSactive			= rsTemp("configVal")
		case lCase("USPSUserID")
			USPSUserID			= rsTemp("configVal")
		case lCase("USPSPassword")
			USPSPassword		= rsTemp("configVal")
		case lCase("USPSfromZip")
			USPSfromZip			= rsTemp("configVal")
		case lCase("USPSservice")
			USPSservice			= rsTemp("configVal")
		case lCase("USPSintNtl")
			USPSintNtl			= rsTemp("configVal")
		case lCase("USPSsize")
			USPSsize			= rsTemp("configVal")
		case lCase("USPSmachinable")
			USPSmachinable		= rsTemp("configVal")
			
		'Canada Post
		case lCase("CPactive")
			CPactive			= rsTemp("configVal")
		case lCase("CPmerchantID")
			CPmerchantID		= rsTemp("configVal")
		case lCase("CPfromZip")
			CPfromZip			= rsTemp("configVal")
		case lCase("CPsizeL")
			CPsizeL				= rsTemp("configVal")
		case lCase("CPsizeW")
			CPsizeW				= rsTemp("configVal")
		case lCase("CPsizeH")
			CPsizeH				= rsTemp("configVal")
		end select
		rsTemp.MoveNext
	loop
	call closeRS(rsTemp)
	
	'Store shipArray in session object
	session(storeID & "shipArray") = shipArray
	
	'Reset UPS Trademark Notice session variable. This variable is loaded with the 
	'UPS Trademark Notice if there were shipping rates returned from the UPS rate
	'server. The contents of this variable is checked and shown where required.
	session(storeID & "UPSnotice") = ""

	'Get UPS Online Rates
	if UPSactive = "Y" then
		shipParms = array(UPSAccessID,UPSUserID,UPSPassword,UPSfromZip,UPSfromCntry,UPSpickupType,UPSpackType,UPSshipCode,UPSweightUnit,UPSallRates,UPSaddrType,totalShipWeight,shippingLocCountry,shippingZip)
		session(storeID & "shipParms") = shipParms
		server.Execute "_INCshipUPS_.asp"
	end if

	'Get USPS Online Rates
	if USPSactive = "Y" then
		'US and Puerto Rico shipping
		if UCase(shippingLocCountry) = "US" _
		or UCase(shippingLocCountry) = "PR" then
			shipParms = array(USPSUserID,USPSPassword,USPSfromZip,USPSservice,USPSsize,USPSmachinable,totalShipWeight,shippingLocCountry,shippingZip)
			session(storeID & "shipParms") = shipParms
			server.Execute "_INCshipUSPS_.asp"
		'International shipping
		else
			if USPSintNtl = "Y" then
				shippingLocCountryDesc = getCountryDesc(shippingLocCountry)
				shipParms = array(USPSUserID,USPSPassword,totalShipWeight,shippingLocCountryDesc)
				session(storeID & "shipParms") = shipParms
				server.Execute "_INCshipUSPSi_.asp"
			end if
		end if
	end if

	'Get Canada Post Online Rates
	if CPactive = "Y" then
		shipParms = array(CPmerchantID,CPfromZip,CPsizeL,CPsizeW,CPsizeH,totalShipWeight,shippingLocCountry,shippingLocState,shippingZip)
		session(storeID & "shipParms") = shipParms
		server.Execute "_INCshipCP_.asp"
	end if

	'Move session shipArray back to local shipArray
	shipArray = session(storeID & "shipArray")

	'Clean up session object
	session(storeID & "shipArray")	= null
	session(storeID & "shipParms")	= null
	
end sub

'*************************************************************************
'Check shipping rate array
'*************************************************************************
function validShipArray()
	
	'Variables
	dim f
	
	'Initialise
	validShipArray = true
	
	'Check array
	if isNull(shipArray(0,0)) or isEmpty(shipArray(0,0)) _
	or isNull(shipArray(0,1)) or isEmpty(shipArray(0,1)) _
	or len(shipArray(0,1)) = 0 then
		validShipArray = false
	else
		for f = 0 to UBound(shipArray)
			if  len(trim(shipArray(f,0))) > 0 _
			and len(trim(shipArray(f,1))) > 0  then
				if len(trim(shipArray(f,1))) > 100 _
				or not(isNumeric(shipArray(f,0))) then
					validShipArray = false
				end if
			end if
		next
	end if
	
end function

'*************************************************************************
'Determine Shipping Zone for shipping destination : Null = Error
'*************************************************************************
function getShipZone(shippingLocCountry,shippingLocState)
	
	'Variables
	dim mySQL, rsTemp
	
	'Determine Zone
	if len(shippingLocState) = 0 then
		mySQL = "SELECT locShipZone " _
			  & "FROM   locations " _
			  & "WHERE  locCountry = '" & validSQL(shippingLocCountry,"A") & "' " _
			  & "AND   (locState = '' OR locState IS NULL) "
	else
		mySQL = "SELECT locShipZone " _
			  & "FROM   locations " _
			  & "WHERE  locCountry = '" & validSQL(shippingLocCountry,"A") & "' " _
			  & "AND    locState = '"   & validSQL(shippingLocState,"A")   & "' "
	end if
	set rsTemp = openRSexecute(mySQL)
	if not rsTemp.eof then
		getShipZone = trim(rsTemp("locShipZone")&"")
	else
		getShipZone = null
	end if
	call closeRS(rsTemp)
	
end function
%>