HEX
Server: Microsoft-IIS/10.0
System: Windows NT ITPWINWEBSVR22 10.0 build 20348 (Windows Server 2022) AMD64
User: www.conferencesearch.co.uk (0)
PHP: 8.3.30
Disabled: NONE
Upload Files
File: D:/web/hyperflight/! previous changes 2/2026-04-09/prev/customutils-delivery-charge-class.asp
<%
' =====================================
' customutils-delivery-charge-class.asp
' =====================================
' Version 1.08 (30/03/26)
' ============
'   HISTORY 
' ============
' (SS,24/07/25) First used, included from customutils-delivery.asp used for new HyperFlight delivery calculation
' (SS,28/07/25) Modified sort order to use new SortOrder field  (Private Function GetPackagingWeight)  
' (SS,11/08/25) Modified RoyalMailApplicable to not use Royal Mail for parcels for UKMain, added LargeLetterApplicable
' (SS,22/08/25) Modified RoyalMailApplicable to not use Royal Mail for US due to tariff changes and halting their services
' (SS,30/08/25) Modified to calculate for data feed mode, i.e. Google Shopping
' (SS,29/09/25) Change to SetDefaults to add FDeliveryCostTotal = 0 to fix issue where it was causing error in SQL when saving DeliveryCalculatedCost of '' to be saved in orders table
' (SS,25/02/26) Change to Private Function GetSurchargeTotal to adjust FAdditionalHandlingSurcharge from 3 to 6.50 
' (SS,24/03/26) Change to Public Property Get Courier to not use Royal Mail if FRMZone is "NONE" (a new ENUM value for RMZone field in countries, added to disable Royal Mail for South Africa), also added Private Property Get RoyalMailDisabled 
' (SS,30/03/26) Increased FedEx FuelSurcharge form 30% to 33% change to Function GetSurchargeTotal




' (SS,5/4/2025)

Class cDeliveryCharge

  Private FObjectName
  Private FIsDataFeedMode ' true when data feed mode i.e. while creating Google shopping data feed
    
  Private FDataFeedProductID ' (SS,29/8/25) used to calculate the delivery cost in data feed mode where we don't have the product in the basket i.e. for the specified product

  Private FCountry, FRegionCode
  
  Private FInternationalFuelSurchargePercentage ' (SS,1/4/26)
  
  Private FTotalValue, FVATContent, FTotalWeight
  
  ' Private FAdjustedWeightRCModels  
  Private FTubeVolumetricWeight
  Private FBoxVolumetricWeight, FMaxVolumetricWeight, FMaxBoxVolumetricWeight, FTotalBoxVolumetricWeight, FAdjustedBoxVolumetricWeight
  
  ' (SS,23/5/25) FPackagingWeight replaces FAdditionalWeightPostalTube
  ' (SS,
  Private FPackagingWeight, FPackageName
  
  ' Private FRoyalMailGrossWeight, FNonRoyalMailGrossWeight
  ' (SS,25/6/25) replaced above with FGrossWeight and FVolumetricWeight
  Private FGrossWeight, FVolumetricWeight
  
  Private FPostalTubeLengthMax, FHasLiPo, FBoxLengthMax, FBoxHeightMax
  
  Private FRCModelCount ' (SS,7/7/25)
  
  Private FDeliveryAgent, FDeliveryCourier
    
  Private FStandardSelected, FTrackedSelected, FExpeditedSelected
  
  Private FTrackedAuto
  
  Private FDeliveryCharge
  
  Private FCountryOptions, FCountryLiPoAllowed, FCountryRoyalMailAllowed, FCountryTrackedOnly
  Private FRMPreferredServiceCode, FRMZone, FFedExZone
  Private FRoyalMailTrackedCheaperThanStandard
  
  Private FErrorMessage
  
  Private FDeliveryCostFromTable, FDeliveryCostExSurcharge
  Private FMarkupPC, FMarkupAmount, FMarkupTotal, FMarkupPCInfoForLog, FMinDeliveryCharge, FMinChargeTopUp
  Private FWeightUpTo, FPostalTubeMax, FAgent
  Private FDeliveryCostTotal
  
  Private FFuelSurcharge, FAdditionalHandlingSurcharge, FSurchargeTotal
  
  ' for interpolation
  'Private FInterpolated, FInterpolatedDeliveryCost, 
  ' (SS,26/6/25) replaced above with following
  Private FInterpolateCharge, FInterpolateCost
  
  Private FDeliveryCostFromTable2, FWeightUpTo2, FMarkupPC2, FMarkupAmount2
  
  Private FDeliveryTableName, FDeliveryZoneField
  Private FSQL, FSQL2, FLog, FLogTypeHTML
  
  Private FBoxLengthList, FBoxVolumetricWeightList
  
  Private FBoxHeightList ' (SS,23/6/25)
  
  
  Private Sub Class_Initialize
    SetDefaults
  End Sub
  

  Public Sub Class_Terminate

  End Sub
  
  
  Public Sub SetDefaults 
    FObjectName = ""
    FIsDataFeedMode = False
    
    FErrorMessage = ""
    
    FCountry = ""
    FRegionCode = ""
    
    FInternationalFuelSurchargePercentage = 33 ' (SS,1/4/26) default of 33%
  
    FTotalValue = 0
    FVATContent = 0
    
    FTotalWeight = 0
    FPostalTubeLengthMax = -1 ' i.e. not postal tube
    FBoxLengthMax = -1    
    FHasLiPo = False
    
    FRCModelCount = 0
    
    FTubeVolumetricWeight = 0
    FBoxVolumetricWeight = 0
    FMaxVolumetricWeight = 0
    FMaxBoxVolumetricWeight = 0
    FTotalBoxVolumetricWeight = 0
    FAdjustedBoxVolumetricWeight = 0
    
    FPackagingWeight = 0
    FGrossWeight = 0
    FVolumetricWeight = 0
    
    FStandardSelected = True
    FTrackedSelected = False
    FExpeditedSelected = False
    FTrackedAuto = False 

    FCountryOptions = ""
    
    FCountryLiPoAllowed = True
    FCountryRoyalMailAllowed = True
    FCountryTrackedOnly = False    
    
    FRoyalMailTrackedCheaperThanStandard = False
        
    FDeliveryCharge = 0
    
    FDeliveryCostTotal = 0  ' (SS,29/9/25) fixed issue where it was causing error in SQL when saving DeliveryCalculatedCost of '' to be saved in orders

    FDeliveryCostFromTable = -1
    FDeliveryCostExSurcharge = 0    
    FMarkupPC = 0
    FMarkupPCInfoForLog = ""
    FMarkupAmount = 0  
    FMarkupTotal = 0 
    FMinDeliveryCharge = 0
    FMinChargeTopUp = 0    
    FWeightUpTo = -1
    FPostalTubeMax = -1
    FAgent = ""
    
    ' FInterpolated = False
    FInterpolateCharge = False
    FInterpolateCost = False
    ' FInterpolatedDeliveryCost = 0
    
    FDeliveryCostFromTable2 = -1
    FWeightUpTo2 = -1
    FMarkupPC2 = 0
    FMarkupAmount2 = 0
    
    FFuelSurcharge = 0
    FAdditionalHandlingSurcharge = 0
    FSurchargeTotal = 0    
    
    FDeliveryTableName = ""
    FDeliveryZoneField = ""
    
    FBoxLengthList = ""
    FBoxVolumetricWeightList = ""
    
    FBoxHeightList = ""
    FBoxHeightMax = -1
    
    FPackageName = ""
    
    FSQL = ""  
    FSQL2 = ""
    FLog = ""
    FLogTypeHTML = False
  End Sub

  Public Property Let ObjectName(AValue)
    FObjectName = AValue
  End Property
  
  Public Property Let IsDataFeedMode(AValue)
    FIsDataFeedMode = AValue
  End Property
  
  Public Property Get IsDataFeedMode
    IsDataFeedMode = FIsDataFeedMode
  End Property

  Public Property Let DataFeedProductID(AValue)
    FDataFeedProductID = AValue
  End Property
  
  Public Property Let Country(AValue)
    FCountry = AValue
  End Property  

  Public Property Get Country
    Country = FCountry
  End Property

  Public Property Let RegionCode(AValue)
    FRegionCode = AValue
  End Property  

  Public Property Get RegionCode
    RegionCode = FRegionCode
  End Property

  ' (SS,1/4/26)
  Public Property Let InternationalFuelSurchargePercentage(AValue)
    FInternationalFuelSurchargePercentage = AValue
  End Property  

  ' (SS,1/4/26)
  Public Property Get InternationalFuelSurchargePercentage
    InternationalFuelSurchargePercentage = FInternationalFuelSurchargePercentage
  End Property
  
  Public Property Let TotalValue(AValue)
    FTotalValue = AValue
  End Property  

  Public Property Get TotalValue
    TotalValue = FTotalValue
  End Property

  Public Property Let VATContent(AValue)
    FVATContent = Round2dp(AValue) '  added Round2dp because it did contain more than 2 dp
  End Property  

  Public Property Get VATContent
    VATContent = FVATContent
  End Property

  Public Property Get TotalValueExcVAT
    TotalValueExcVAT = Round2dp(FTotalValue - FVATContent)
  End Property

  Public Property Let TotalWeight(AValue)
    FTotalWeight = AValue
  End Property  

  Public Property Get TotalWeight
    TotalWeight = FTotalWeight
  End Property
  
  ' (SS,26/6/25) was TotalGrossWeight, actual weight used for delivery calculation
  Public Property Get DeliveryCalcWeight
    If Courier = "Royal Mail" Then
      DeliveryCalcWeight = FGrossWeight
    Else
      DeliveryCalcWeight = MAX(FGrossWeight, FVolumetricWeight)
    End If
  End Property
  
  ' (SS,19/5/25) rename of TotalAdjustedWeight
  Public Property Get EstimatedGrossWeight
    EstimatedGrossWeight = FGrossWeight
  End Property

  ' (SS,25/6/25)
  Public Property Get EstimatedVolumetricWeight
    EstimatedVolumetricWeight = FVolumetricWeight ' was FAdjustedBoxVolumetricWeight
  End Property       

  Public Property Get DeliveryCharge
    DeliveryCharge = FDeliveryCharge
  End Property
  
  ' returns true when there's a postal tube upgrade to box, also adjusts FBoxLengthMax to larger box if applicable
  Private Property Get PostalTubeToBoxUpgradeApplicable
    ' PostalTubeToBoxUpgradeApplicable = FPostalTubeLengthMax >= 150 And FBoxLengthMax = 105
    ' (SS,30/6/25) replaced above with following
    Dim LResult
    LResult = False
    PostalTubeToBoxUpgradeApplicable = FPostalTubeLengthMax >= 150 And FBoxLengthMax = 105
    ' (SS,22/7/25) change > 0 to > -1 for FPostalTubeLengthMax, because 0 means there is a postal tube because it's not -1
    If FPostalTubeLengthMax > -1 And FBoxLengthMax > 0 Then
      ' if postal tube 105 or less and box 105 or more then no need for postal tube
      If FPostalTubeLengthMax <= 105 And FBoxLengthMax >= 105 Then       
        LResult = True
      ' if postal tube >= 150 and box >= 105 but less than 152 then use larger box of 152 instead of postal tube
      ElseIf FPostalTubeLengthMax >= 150 And FBoxLengthMax >= 105 And FBoxLengthMax < 152 Then  
        FBoxLengthMax = 152
        LResult = True
      ' if postal tube >= 150 and box already >= 152 then need for postal tube
      ElseIf FPostalTubeLengthMax >= 150 And FBoxLengthMax >= 152 Then
        LResult = True
      End If
    End If

    PostalTubeToBoxUpgradeApplicable = LResult
  End Property
  
  Private Sub AddErrorMessage(AValue)
    If FErrorMessage <> "" Then
      FErrorMessage = FErrorMessage + Chr(13) + Chr(10) 
    End If
    FErrorMessage = FErrorMessage + AValue
  End Sub
  
  Public Property Get ErrorMessage
    ErrorMessage = FErrorMessage
  End Property  
  
  Public Property Get Error
    Error = FErrorMessage <> ""
  End Property  
  
  ' (SS,23/5/25) new verison, makes use of GetPackagingWeight
  ' (SS,29/5/25) renamed CalculateAdjustedWeight to CalculateGrossWeight
  ' (SS,25/6/25) renamed from CalculateGrossWeight to CalculateWeight
  Private Sub CalculateWeight
  
    ' adjust for multiple RC Models
    ' (SS,26/6/25) no longer used
    ' FAdjustedWeightRCModels = GetAdjustedWeightRCModels(FTotalWeight)    
    
    ' FBoxLengthMax = GetAttributeInBasketMaxValue("Minimum Box Length")
    ' (SS,23/6/25) following replaces above to get maximum of Minimum Box Length into FBoxLengthMax
    GetMaxBoxLength
    
    GetMaxBoxHeight ' get the maximum of Minimum Box Height from attribute and category/subcategory into FBoxHeightMax
    
    ' if postal tube to box upgrade applicable then use box length to calculate BoxVolumetricWeight
    Dim LPostalTubeUpgradeToBox
    ' PostalTubeToBoxUpgradeApplicable will increase FBoxLengthMax if applicable
    LPostalTubeUpgradeToBox = PostalTubeToBoxUpgradeApplicable
    
    ' additional weight for postal tube and other packaging
    FPackagingWeight = 0

    ' if postal tube and upgrade to box not applicable then lookup tube
    ' (SS,24/6/25) ? may need to check FBoxHeightMax not > than tube diameter?
    If FPostalTubeLengthMax >= 0 And Not LPostalTubeUpgradeToBox Then
      ' FPackagingWeight = GetPackagingWeight(FPostalTubeLengthMax, FBoxHeightMax, False, True, False, LWeightIsVolumetric)      
      FPackagingWeight = GetPackagingWeight(FPostalTubeLengthMax, FBoxHeightMax, False, True, FPackageName, FTubeVolumetricWeight)
    Else
      ' attempt large letter, FBoxHeightMax being above 2 will prevent large letter
      FPackagingWeight = GetPackagingWeight(FBoxLengthMax, FBoxHeightMax, True, False, FPackageName, FBoxVolumetricWeight)

      ' if not large letter then try non large letter, with volumetric           
      ' (SS,30/5/25) removed volumetric, last True changed to False
      If FPackagingWeight = 0 Then
        FPackagingWeight = GetPackagingWeight(FBoxLengthMax, FBoxHeightMax, False, False, FPackageName, FBoxVolumetricWeight)
      End If
    End If
    
    ' FGrossWeight = FAdjustedWeightRCModels + FPackagingWeight
    ' (SS,26/6/25) replaced above with following, FAdjustedWeightRCModels not longer used
    FGrossWeight = FTotalWeight + FPackagingWeight
    
    ' (SS,16/5/25) for Royal Mail, apply weight adjust ratio, only if there was no adjustment already applied for RC Models
    ' ? question, apply if below a certain amount
    'If FAdjustedWeightRCModels = FTotalWeight Then
    '  FRoyalMailAdjustedWeight = Round(FRoyalMailAdjustedWeight + (FTotalWeight * (ROYAL_MAIL_WEIGHT_ADJUST_RATIO - 1)), 0)
    'End If
    
    FBoxVolumetricWeight = GetBoxVolumetricWeight(FBoxLengthMax)
    FMaxVolumetricWeight = Max(FTubeVolumetricWeight, FBoxVolumetricWeight)
    ' (SS,30/6/25) if postal upgrade resulted in a large box then adjust the max box volumetric weight (a bit messy, I know)
    If FBoxVolumetricWeight > FMaxBoxVolumetricWeight Then
      FMaxBoxVolumetricWeight = FBoxVolumetricWeight
    End If 
    
    ' (SS,29/5/25) added FPackagingWeight
    ' FNonRoyalMailGrossWeight = Max(FAdjustedWeightRCModels + FPackagingWeight, FMaxVolumetricWeight)
    
    ' applicable multiple box length volumetric weight adjustment
    GetAdjustedBoxVolumetricWeight
    
    ' (SS,30/6/25) if box volumetric is 0 and there's a tube volumetric then set FVolumetricWeight to the tube volumetric
    If FVolumetricWeight = 0 And FTubeVolumetricWeight > 0 Then
      FVolumetricWeight = FTubeVolumetricWeight
    End If
    
    ' FNonRoyalMailGrossWeight = Max(FNonRoyalMailGrossWeight, FAdjustedBoxVolumetricWeight)    
    
    
  End Sub
  
  ' (SS,30/5/25)
  Private Function ContentWeight
    ContentWeight = FTotalWeight ' was FAdjustedWeightRCModels
  End Function
  
  ' (SS,23/5/25)
  ' (SS,30/5/25) renamed AIsVolumetric to AIsTubeVolumetric, added AWeightIsVolumetric parameter which returns the type of weight found
  ' (SS,24/6/25) added AHeight
  ' (SS,25/6/25) removed AIsTubeVolumetric and ByRef AWeightIsVolumetric, added ByRef APackageName, ByRef AVolumetricWeight
  ' (SS,28/7/25) modified sort order to use new SortOrder field  
  Private Function GetPackagingWeight(ALength, AHeight, AIsLargeLetter, AIsTube, ByRef APackageName, ByRef AVolumetricWeight)
    Dim LSQL, LPackageName, LNormalWeight, LVolumetricWeight
   
    
    ' (SS,30/5/25) added MaxContentWeightAllowed for content weight limit for Large Letter
    LSQL = "SELECT PackageName, NormalWeight, VolumetricWeight FROM delivery_package_names"
    LSQL = LSQL + " WHERE "
    LSQL = LSQL + " LargeLetter = " & IIf(AIsLargeLetter, 1, 0)
    LSQL = LSQL + " AND Tube = " & IIf(AIsTube, 1, 0)    
    LSQL = LSQL + " AND Length >= " & ALength
    LSQL = LSQL + " AND Height >= " & AHeight
    LSQL = LSQL + " AND (MaxContentWeightAllowed = 0 OR MaxContentWeightAllowed >= " & ContentWeight & ")"
    'LSQL = LSQL + " ORDER BY Length"
    ' (SS,28/7/25) replaced above with following order
    LSQL = LSQL + " ORDER BY SortOrder, LargeLetter DESC, Length, Height"
    
    
    If Not GetSQL3Values(LSQL, LPackageName, LNormalWeight, LVolumetricWeight) Then
      LPackageName = ""
      LNormalWeight = 0
      LVolumetricWeight = 0      
    End If
    
    APackageName = LPackageName
    AVolumetricWeight = LVolumetricWeight
    
    ' Response.Write "### GetPackagingWeight = Length: " & ALength & ", LPackageSizeName: " & LPackageSizeName & ", LVolumetricWeight: " & LVolumetricWeight & ", LNormalWeight: " & LNormalWeight & ", Result: " & LResult & BR
    
    GetPackagingWeight = LNormalWeight    
  End Function  
  
  ' (SS,8/7/22) code separated from CustomGetDelivery, not called if it's for a Google Data Feed
  ' (SS,3/4/25) renamed from CustomGetAdjustedWeight to CustomGetAdjustedWeightRCModels
  ' (SS,11/4/25) moved from customutils and renamed from CustomGetAdjustedWeightRCModels to GetAdjustedWeightRCModels
  ' (SS,26/6/25) no longer used, can be deleted
  Private Function GetAdjustedWeightRCModels(ATotalWeight)
    ' (SS,12/5/21) removed LAboveMediumRCModelWeight, added LHeavyRCModelTotalWeight
    Dim LHeaviestRCModelWeight, LHeavyRCModelTotalWeight, LRCModelTotalWeight, LTotalWeight, LAdjustedWeight
    
    ' (SS,12/5/21) removed RC_MODEL_MEDIUM_REF_WEIGHT
    'Const RC_MODEL_HEAVY_REF_WEIGHT = 1500
    ' Const RC_MODEL_MEDIUM_REF_WEIGHT = 1000
    'Const RC_MODEL_WEIGHT_ADJUSTMENT_FACTOR = 0.3
     
    ' (SS,12/5/21) removed parameters RC_MODEL_MEDIUM_REF_WEIGHT (3rd), replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
    ' values RC_MODEL_MEDIUM_REF_WEIGHT and LRCModelTotalWeight are ByRef and passed back here
    ' (SS,3/6/21) routine GetWeightRangeForCategory is not compatible with or applicable to the Google Shopping Data Feed i.e. DoGoogleShoppingDataFeed
    ' it prevents DoGoogleShoppingDataFeed from working by giving oRS type mismatch error, fixed issue by not calling GetWeightRangeForCategory
    ' when this routine gets called from DoGoogleShoppingDataFeed by using Not InGoogleShoppingDataFeed
    ' N.B.!!! modifying GetWeightRangeForCategory to use OpenQuery2 instead of OpenQuery or DoGoogleShoppingDataFeed to use OpenQuery2 or OpenQuery3 won't work due to use of GetPricingFromProductRecord
    If GetWeightRangeForCategory("RC Models", RC_MODEL_HEAVY_REF_WEIGHT, LHeaviestRCModelWeight, LHeavyRCModelTotalWeight, LRCModelTotalWeight, LTotalWeight) Then
        
      ' (SS,12/5/21) replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
      LAdjustedWeight = LTotalWeight - Int((LHeavyRCModelTotalWeight - LHeaviestRCModelWeight) * (1 - RC_MODEL_WEIGHT_ADJUSTMENT_FACTOR))      
      
      ' (SS,7/6/21) sets the new TotalWeight to save later in the order record
      ' (SS,3/4/25) removed following, done in calling routine
      'If ATotalWeight <> LAdjustedWeight Then
      '  SetAdjustedTotalWeight(LAdjustedWeight)
      'End If
      
     ' If SHOW_DEBUG_INFO Then
     '   Response.Write "AdjustedWeight: " & LAdjustedWeight & BR
     '   Response.Write "NewNormalDeliveryCost: " & LNormalDeliveryCost & BR    
     '   Response.Write "*** HEAVY RC MODEL DETECTED END ***" & BR    
     '   Response.Write "" & BR
     ' End If
    Else ' return the same weight i.e. no change
      LAdjustedWeight = ATotalWeight
    End If
    
    GetAdjustedWeightRCModels = LAdjustedWeight
  End Function   
  
  Private Function GetBoxVolumetricWeight(ABoxLength)
    ' boolean for not large letter, not tube and volumetric
    ' (SS,18/6/25) renamed PackageSize to PackageName 
    'Dim LPreservePackageName, LWeightIsVolumetric, LResult
    'LPreservePackageName = FPackageName
    ' (SS,25/6/25) replaced above with following no need to preserve FPackageName anymore
    Dim LResult, LPackageName, LVolumetricWeight
    
    LVolumetricWeight = 0
    
    ' (SS,24/6/25) added -1 for ABoxHeight to effectively ignore height
    LResult = GetPackagingWeight(ABoxLength, -1, False, False, LPackageName, LVolumetricWeight)    
    
    GetBoxVolumetricWeight = LVolumetricWeight
  End Function  

  ' (SS,14/4/25)
  ' (SS,23/6/25) modified to use due to GetMaxBoxLength which calls AttributeOrCatInBasketCallback instead of AttributeInBasketCallback
  ' (SS,26/6/25) adjusted 0.5 to 0.2 i.e. 50% to 25%
  ' (SS,8/7/25) adjusted back to 0.5 from 0.25
  Private Sub GetAdjustedBoxVolumetricWeight
    ' apputils.asp routine, does callback via customutils-delivery.asp to call oDeliveryCharge.BoxLengthAttributeBasketCallback
    ' AttributeInBasketCallback "Minimum Box Length", FObjectName + ".BoxLengthAttributeBasketCallback"
    
    FAdjustedBoxVolumetricWeight = 0
    If FTotalBoxVolumetricWeight > 0 Then
      FAdjustedBoxVolumetricWeight = FMaxBoxVolumetricWeight
      If FTotalBoxVolumetricWeight > FMaxBoxVolumetricWeight Then
        FAdjustedBoxVolumetricWeight = RoundDP(FAdjustedBoxVolumetricWeight + ((FTotalBoxVolumetricWeight - FMaxBoxVolumetricWeight) * 0.5), 0)
      End If
    End If
    FVolumetricWeight = FAdjustedBoxVolumetricWeight ' (SS,25/6/25)
  End Sub
  
  Private Sub GetMaxBoxLength
    ' apputils.asp routine, does callback via customutils-delivery.asp to call oDeliveryCharge.BoxLengthAttributeBasketCallback
    FBoxLengthMax = -1
    
    ' (SS,30/8/25) different for data feed mode, i.e. based on given product instead of basket
    If IsDataFeedMode Then
      FBoxLengthMax = GetProductAttributeOrCatIntegerValue(FDataFeedProductID, "Minimum Box Length")
      FTotalBoxVolumetricWeight = GetBoxVolumetricWeight(FBoxLengthMax)
      FMaxBoxVolumetricWeight = FTotalBoxVolumetricWeight
    Else ' as before
      AttributeOrCatInBasketCallback "Minimum Box Length", "MinimumBoxLength", FObjectName + ".BoxLengthAttributeBasketCallback"
    End If
  End Sub
  
  ' called from apputils.asp for each item in basket with attribute "Minimum Box Length", called with value and qty
  Public Sub BoxLengthAttributeBasketCallback(ABoxLength, AQty)  
    ' exit if attribute has not value i.e. is blank, shouldn't happen
    If ABoxLength = "" Then Exit Sub
    
    Dim LQtySuffix
    If AQty = 1 Then
      LQtySuffix = ""
    Else
      LQtySuffix = " x " & AQty
    End IF
    
    AddToList FBoxLengthList, ABoxLength & LQtySuffix

    Dim LBoxLength, LVolumetricWeight
    LBoxLength = CLng(ABoxLength)
    LVolumetricWeight = GetBoxVolumetricWeight(LBoxLength)
    
    ' (SS,23/6/25)
    If LBoxLength > FBoxLengthMax Then FBoxLengthMax = LBoxLength
    
    AddToList FBoxVolumetricWeightList, LVolumetricWeight & LQtySuffix
    
    FTotalBoxVolumetricWeight = FTotalBoxVolumetricWeight + LVolumetricWeight * AQty
    If LVolumetricWeight > FMaxBoxVolumetricWeight Then FMaxBoxVolumetricWeight = LVolumetricWeight

  End Sub
  
  Private Sub GetMaxBoxHeight
    ' apputils.asp routine, does callback via customutils-delivery.asp to call oDeliveryCharge.BoxLengthAttributeBasketCallback
    FBoxHeightMax = -1
    
    ' (SS,30/8/25) different for data feed mode, i.e. based on given product instead of basket
    If IsDataFeedMode Then
      FBoxHeightMax = GetProductAttributeOrCatIntegerValue(FDataFeedProductID, "Minimum Box Height")
    Else
      AttributeOrCatInBasketCallback "Minimum Box Height", "MinimumBoxHeight", FObjectName + ".BoxHeightAttributeBasketCallback"
    End If
  End Sub

  ' (SS,23/6/25)
  ' called from apputils.asp for each item in basket with attribute "Minimum Box Length", called with value and qty
  Public Sub BoxHeightAttributeBasketCallback(ABoxHeight, AQty) 
    ' exit if attribute has not value i.e. is blank, shouldn't happen
    If ABoxHeight = "" Then Exit Sub
    
    Dim LBoxHeight
    LBoxHeight = CDbl(ABoxHeight)
    If LBoxHeight > FBoxHeightMax Then FBoxHeightMax = LBoxHeight
    
    Dim LQtySuffix
    If AQty = 1 Then
      LQtySuffix = ""
    Else
      LQtySuffix = " x " & AQty
    End IF
    
    AddToList FBoxHeightList, ABoxHeight & LQtySuffix

  End Sub  
  
  Private Sub AddToList(ByRef AList, AValue)
    Dim LValue
    LValue = CStr(AValue)
    If LValue <> "" Then
      If AList <> "" Then AList = AList + ", "
      AList = AList + LValue 
    End If
  End Sub

  Public Sub Calculate
  
    ' functions GetStandardDeliverySelected, GetTrackedDeliverySelected, GetExpeditedDeliverySelected are in apputils.asp
    ' only do the following, due to overhead, if not in data feed creation
    If Not IsDataFeedMode Then
      FStandardSelected = GetStandardDeliverySelected
      FTrackedSelected = GetTrackedDeliverySelected
      FExpeditedSelected = GetExpeditedDeliverySelected
      
      ' following looks up the maximum value from the options, value in attribute itself is ignore
      FPostalTubeLengthMax = GetAttributeInBasketMaxOptionValue("Requires Postal Tube")
      ' (SS,22/7/25) following looks up the value from attribute itself uses whichever is the larger
      FPostalTubeLengthMax = Max(FPostalTubeLengthMax, GetAttributeInBasketMaxValue("Requires Postal Tube"))
      
      FHasLiPo = GetAttributeInBasketCount("LiPo", "") > 0
      
      ' (SS,7/7/25) just for testing and saving in delivery_invoices
      FRCModelCount = GetCategoryInBasketCount("RC Models", "")
    
    Else ' (SS,30/8/25) datafeed mode
      
      FStandardSelected = True
      
      FPostalTubeLengthMax = GetProductAttributeIntegerValue(FDataFeedProductID, "Requires Postal Tube")
      
      FHasLiPo = ProductAttributeExists(FDataFeedProductID, "LiPo")
      
    End If
    
    ' options check
    ' T for tracked
    ' N for not Royal Mail
    ' L for LiPo allowed
    GetCountrySettings ' gets various settings from countries table including Options into FCountryOptions
    FCountryLiPoAllowed = InStr(1, FCountryOptions, "L", vbTextCompare) > 0
    FCountryRoyalMailAllowed = InStr(1, FCountryOptions, "N", vbTextCompare) = 0
    FCountryTrackedOnly = InStr(1, FCountryOptions, "T", vbTextCompare) > 0

    ' set error of LiPo in basket and not allowed in country
    If FHasLiPo Then
      ' If InStr(",United Kingdom,Belgium,France,Germany,Italy,Netherlands,Spain,", "," & ACountry & ",") = 0 Then  
      ' (SS,4/4/25) aboved from (SS,6/5/21) replaced with check for L in country options field
      If Not FCountryLiPoAllowed Then    
        AddErrorMessage("Sorry we can't deliver batteries to your region, please remove from basket")
      End If      
    End If    
    
    CalculateWeight
      
    LookupDelivery          
    
  End Sub
  
  ' gets from the countries table: Options, RMPreferredServiceCode, RMZone and FedExZone
  Private Sub GetCountrySettings       
    If Not GetSQL4Values("SELECT Options, RMPreferredServiceCode, RMZone, FedExZone FROM Countries WHERE Country = '" + CleanSQLStr(FCountry) + "'", FCountryOptions, FRMPreferredServiceCode, FRMZone, FFedExZone) Then
      AddErrorMessage "Country not found: " & FCountry
    End If
    FCountryOptions = NB(FCountryOptions)
    FRMPreferredServiceCode = NB(FRMPreferredServiceCode)
    FRMZone = NB(FRMZone)
    FFedExZone = NB(FFedExZone)
    
    ' if RMZone blank then assume WZ1
    If FRMZone = "" Then FRMZone = "WZ1"  
  End Sub

  Public Property Get Courier
    Dim LResult
    ' choose courier based on country and type of delivery
    If IsUK Then
      If IsTracked Or IsExpedited Or Not RoyalMailApplicable Then
        LResult = "DHL"
      Else
        LResult = "Royal Mail"
      End If
    Else ' non-UK
      ' (SS,24/3/26) added Or RoyalMailDisabled
      If IsExpedited Or RoyalMailDisabled Then
        LResult = "FedEx"
      ElseIf IsTracked Then
        If RoyalMailApplicable Then
          LResult = "Royal Mail"
        Else
          LResult = "FedEx"
        End If
      Else ' standard
        LResult = "Royal Mail"
      End If
    End If    
    Courier = LResult 
  End Property
  
  ' (SS,24/3/26) added following to disable Royal Mail when RMZone is "NONE"
  Private Property Get RoyalMailDisabled
    RoyalMailDisabled = FRMZone = "NONE"
  End Property  
  
  Private Property Get RoyalMailApplicable
    Dim LResult
    If IsUK Then
      If IsUKMain Then
        ' (SS,11/8/25) added And LargeLetterApplicable to not use Royal Mail for parcel for UK mainland
        LResult = FGrossWeight <= ROYAL_MAIL_MAX_WEIGHT_UK_MAIN And LargeLetterApplicable       
      Else ' i.e. UKIslands
        LResult = FGrossWeight <= ROYAL_MAIL_MAX_WEIGHT_UK_ISLANDS
      End If
    ' (SS,22/8/25) halting US deliveries via Royal Mail due to recent halting by RM because of Tariff changes
    ElseIf IsUS Then
      LResult = False
    Else     
      LResult = FGrossWeight <= ROYAL_MAIL_MAX_WEIGHT_INTERNATIONAL
    End If
    
    ' (SS,7/7/25) if value >= Royal Mail limit i.e. £500 then don't use Royal Mail
    If LResult And TotalValueExcVAT >= ROYAL_MAIL_VALUE_LIMIT Then
      LResult = False
    End IF
    
    RoyalMailApplicable = Not FHasLiPo And FPostalTubeLengthMax <= 90 And FBoxLengthMax <= 60 And LResult    
  End Property
  
  ' (SS,12/6/25)
  Private Property Get PackageSizeIsLargeLetter
    ' (SS,11/8/25) moved some of code to separate LargeLetterApplicable, needed without use of Courier = "Royal Mail"
    PackageSizeIsLargeLetter = LargeLetterApplicable And Courier = "Royal Mail"
  End Property
  
  ' (SS,11/8/25) needed this without using Courier = "Royal Mail" because using PackageSizeIsLargeLetter will result in recursion when called from RoyalMailApplicable 
  Private Property Get LargeLetterApplicable
    LargeLetterApplicable = FGrossWeight <= ROYAL_MAIL_LARGE_LETTER_MAX_WEIGHT And FBoxHeightMax <= 2.5 And Not HasPostalTube   
  End Property
  
  ' (SS,12/6/25)
  ' (SS,18/6/25) PackageType renamed back to PackageSize
  Public Property Get PackageSize
    If PackageSizeIsLargeLetter Then
      PackageSize = "Large Letter"
    Else
      PackageSize = "Parcel"
    End If 
  End Property
  
  ' i.e. when it needs to be tracked, changed to tracked if standard selected
  Private Property Get TrackedApplicable
    TrackedApplicable = FHasLiPo Or TotalValueExcVAT >= TRACKING_MANDATORY_VALUE Or Not RoyalMailApplicable
  End Property

  Public Property Get Service
    If IsExpedited Then
      Service = "EXP"
    ElseIf Courier <> "Royal Mail" Then
      Service = "STD"
    Else ' i.e. Courier = "Royal Mail"   
      If IsUK Then
        Service = "CRL24"
      ElseIf IsTracked Then
        Service = "OTA"
      Else
        Service = "OLA"
      End If
    End If
  End Property
  
  Private Property Get ServiceIsOLA
    ServiceIsOLA = Service = "OLA" ' i.e. standard/untracked Royal Mail
  End Property

  Public Property Get PackageName
    PackageName = FPackageName
  End Property

  Public Property Get Agent
    If Courier = "Royal Mail" Then
      Agent = "Royal Mail"
    Else
      Agent = "WebShip"
    End If    
  End Property
  
  Public Property Get IsStandard
    IsStandard = Not IsTracked And Not IsExpedited
  End Property
  
  Public Property Get IsTracked
    IsTracked = FCountryTrackedOnly Or FTrackedSelected Or FTrackedAuto
  End Property
  
  Public Property Get IsExpedited
    IsExpedited = FExpeditedSelected
  End Property
  
  Public Property Get IsTrackedAuto
    IsTrackedAuto = FTrackedAuto
  End Property  

  Private Property Get IsUK
    IsUK = IsUKMain Or IsUKIslands
  End Property
  
  Private Property Get IsUKMain
    IsUKMain = FRegionCode = "UK"
  End Property

  Private Property Get IsUKIslands
    IsUKIslands = FRegionCode = "UK2"
  End Property
  
  Private Property Get IsInternational
    IsInternational = Not IsUK
  End Property
  
  ' (SS,22/8/25)
  Private Property Get IsUS
    IsUS = Country = "United States"
  End Property  

  Private Property Get IsRoyalMail
    IsRoyalMail = Courier = "Royal Mail"
  End Property
  
  Private Property Get IsFedEx
    IsFedEx = Courier = "FedEx"
  End Property
  
  Private Property Get IsDHL
    IsDHL = Courier = "DHL"
  End Property  
  
  ' if no tube then returns -1, if 0 then it returns 1, else actual value
  Private Property Get PostalTubeLengthMin
    If FPostalTubeLengthMax = 0 Then
      PostalTubeLengthMin = 1
    ElseIf FPostalTubeLengthMax > 0 Then
      PostalTubeLengthMin = FPostalTubeLengthMax
    Else ' i.e not tube
      PostalTubeLengthMin = -1
    End If
  End Property
  
  ' (SS,12/6/25)
  Private Property Get HasPostalTube
    HasPostalTube = PostalTubeLengthMin <> -1
  End Property
 
  Public Property Get Priority
'Suggestion 3:
'1 = Royal Mail - standard - UK
'2 = Royal Mail - standard - international
'3 = Royal Mail - tracked - international
'4 = Courier - tracked - UK (DHL)
'5 = Courier - tracked - international only (FedEx)
'6 = Courier - expedited - UK (?)
'7 = Courier - expedited - international only (FedEx) 
    If IsRoyalMail Then
      If IsUK Then
        Priority = 1
      ElseIf IsTracked Then
        Priority = 3
      Else
        Priority = 2
      End If    
    Else
      If IsExpedited Then
        If IsUK Then
          Priority = 6
        Else
          Priority = 7
        End If
      Else
        If IsUK Then
          Priority = 4
        Else
          Priority = 5
        End If
      End If
    End If
      
  End Property
  
  ' (SS,7/7/25)
  Public Property Get RCModelCount
    RCModelCount = FRCModelCount
  End Property
  
  ' (SS,8/9/25) public, passed back to creator
  Public Property Get BoxHeight
    BoxHeight = FBoxHeightMax
  End Property
  
  ' (SS,8/9/25) public, passed back to creator
  Public Property Get BoxLength
    BoxLength = FBoxLengthMax
  End Property
  
  ' (SS,8/9/25) public, passed back to creator
  Public Property Get TubeLength
    TubeLength = FPostalTubeLengthMax
  End Property  
  
  
  Private Property Get DeliveryCostFromTable
    DeliveryCostFromTable = FDeliveryCostFromTable
  End Property
  
  ' (SS,19/6/25) value stored in order table, for Royal Mail and UK we're not interpolating, i.e. only FedEx international
  ' calculated delivery cost is only interpolated for international and FedEx
  ' (SS,26/6/25) FDeliveryCostTotal now takes interpolatation into account
  Public Property Get DeliveryCalculatedCost
    'If FInterpolated And IsInternational And IsFedEx then 
    '  DeliveryCalculatedCost = FDeliveryCostTotal
    'Else
    '  DeliveryCalculatedCost = FDeliveryCostFromTable + FSurchargeTotal
    'End If
    DeliveryCalculatedCost = FDeliveryCostTotal
  End Property  
  
  Private Sub LookupDelivery
  
  ' New version, some or all superceding the above
' ===========
'Minimum UK delivery constant

'Parcel attributes:
'Value: If value > 250 Service forced to >= tracked
'Size - large letter or parcel
'Weight
'Service: Normal / Tracked / Expedited
'Postal tube & length - get it to set a min weight only
'Lipo - get it to set a min service 
'Destination: UK mainland, UK Islands, overseas

'I think we should put most of the "algorithm" in tables, and look up the cost from the table and display the cost + markup

'Would be good if algorithm can select the Agent see proposed table - Sheet 3

'Rob said he is most interested in seeing the Completion tab sorted by Agent, FedEx, then DHL, then RM


' Service/Priority:
' 1 = Standard
' 2 = Tracked
' 3 = Expedited


' ===========
' Get region code
' Get value
' Determine final adjusted weight for RC modules
'   also postal tube
' Adjust for LiPo (can't use Royal Mail) i.e default to tracked?

    ' if standard, and tracked required i.e. LiPo or value > 250 then set tracked (auto)  
    If FStandardSelected And TrackedApplicable Then
      FTrackedAuto = True
    End If
    
    If TotalWeight = 0 Then ' (SS,8/9/25) if no weight then set delivery charge to 0 e.g. special items like subscription or £1 general sale from no weight
      FDeliveryCharge = 0 
    ElseIf IsUK Then
     ' FDeliveryCharge = GetUKDelivery
      FDeliveryCharge = GetDeliveryFromTable_("deliverycosts_uk", IIf(IsUKMain, "UKMain", "UKIslands"))
    ElseIf Courier = "Royal Mail" Then
      FDeliveryCharge = GetDeliveryFromTable_("deliverycosts_int_rm", FRMZone)
    Else 
      FDeliveryCharge = GetDeliveryFromTable_("deliverycosts_int_fedex", FFedExZone)
    End If
  
  End Sub
  
  ' function called GetDeliveryFromTable exists in apputils.asp and called elsewhere in this class, renamed to GetDeliveryFromTable_
  ' (SS,26/6/25) replaced interpolate with interpolate charge, added interpolate cost
  Private Function GetDeliveryFromTable_(ATableName, AZoneField)
    Dim LResult    
    LResult = -1
    
    FDeliveryTableName = ATableName
    FDeliveryZoneField = AZoneField
  
    If FDeliveryZoneField = "" Then
      GetDeliveryFromTable_ = LResult ' i.e. -1
      AddErrorMessage "Delivery not found (no zone set for country in " + FDeliveryTableName + ")"
      Exit Function
    End If    

    ' Dim LInterpolate, LInterpolate2
    Dim LInterpolateCharge, LInterpolateCharge2, LInterpolateCost, LInterpolateCost2, LInterpolatedDeliveryCost
    
    ' (SS,14/4/25) check if Royal Mail international tracked is cheaper than standard
    ' set to tracked if it is cheaper
    If IsInternational And IsRoyalMail And IsStandard And ServiceIsOLA Then
      If IsRoyalMailTrackedCheaperThanStandard Then
        FTrackedAuto = True ' this will automatically set service to OTA
        FRoyalMailTrackedCheaperThanStandard = True ' used for debug log
      End If
    End If


    ' get normal range i.e. >= 
    If GetDeliveryTableValues(DeliveryCalcWeight, False, False, Service, PackageSize, FDeliveryCostFromTable, FWeightUpTo, LInterpolateCharge, LInterpolateCost, FMarkupPC, FMarkupAmount) Then    
      FDeliveryCostExSurcharge = FDeliveryCostFromTable
      FSurchargeTotal = GetSurchargeTotal(FDeliveryCostFromTable)
      FDeliveryCostTotal = Round2dp(FDeliveryCostFromTable + FSurchargeTotal)
      FMarkupTotal = GetMarkupTotal(FDeliveryCostTotal, FMarkupPC, FMarkupAmount)
      LResult = Round2dp(FDeliveryCostTotal + FMarkupTotal)  ' (SS,24/7/25) was GetDeliveryFromTable_ =, replaced with LResult =       
    Else
      GetDeliveryFromTable_ = LResult ' i.e. -1
      AddErrorMessage "Delivery not found in " + FDeliveryTableName
      Exit Function
    End If
     
    
    ' if interpolation applicable then lookup the previous record
    FInterpolateCharge = False
    FInterpolateCost = False
    If (LInterpolateCharge Or LInterpolateCost) And FWeightUpTo <> DeliveryCalcWeight Then
    
      ' (SS,21/7/25) added flag because calc split into two with some code the same, different interpolation for Royal Mail
      Dim LApplyFlag
      LApplyFlag = False
            
      If Not IsRoyalMail Then
        ' normal version, as before, used for non Royal Mail
      
        If GetDeliveryTableValues(DeliveryCalcWeight, False, True, Service, PackageSize, FDeliveryCostFromTable2, FWeightUpTo2, LInterpolateCharge2, LInterpolateCost2, FMarkupPC2, FMarkupAmount2) Then
          If (LInterpolateCharge2 or LInterpolateCost2) And FDeliveryCostFromTable <> FDeliveryCostFromTable2 Then
            LApplyFlag = True
            If LInterpolateCharge2 Then FInterpolateCharge = True
            If LInterpolateCost2 Then FInterpolateCost = True                   
            FDeliveryCostExSurcharge = GetInterpolatedDeliveryCost(DeliveryCalcWeight, FWeightUpTo, FWeightUpTo2, FDeliveryCostFromTable, FDeliveryCostFromTable2)
          End If
        End If
      Else
        ' (SS,21/7/25) Royal Mail special version
        ' using LWeightUpTo + 1 as first parameter, and next (not previous) instead of AWeight     
        ' first call just to get the lower range as normal, but price from next
        
        Dim LWeightUpToLow, LDeliveryCostLow, LMarkupPCLow, LMarkupAmountLow, LInterpolateChargeLow, LInterpolateCostLow
                
        If GetDeliveryTableValues(FWeightUpTo, False, True, Service, PackageSize, LDeliveryCostLow, LWeightUpToLow, LInterpolateChargeLow, LInterpolateCostLow, LMarkupPCLow, LMarkupAmountLow) Then
          ' following looks up next value, package size is ignored to allow letter to merge into parcel if large letter          
          If GetDeliveryTableValues(FWeightUpTo, True, False, Service, IIf(PackageSizeIsLargeLetter, "", PackageSize), FDeliveryCostFromTable2, FWeightUpTo2, LInterpolateCharge2, LInterpolateCost2, FMarkupPC2, FMarkupAmount2) Then
            If FDeliveryCostFromTable <> FDeliveryCostFromTable2 Then
              LApplyFlag = True
              If LInterpolateChargeLow Then FInterpolateCharge = True
              If LInterpolateCostLow Then FInterpolateCost = True
              FMarkupPC = LMarkupPCLow
              FMarkupAmount = LMarkupAmountLow              
              
              ' (SS,21/7/25) reverse order and different weight range            
              FDeliveryCostExSurcharge = GetInterpolatedDeliveryCost(DeliveryCalcWeight, FWeightUpTo, LWeightUpToLow, FDeliveryCostFromTable2, FDeliveryCostFromTable)
            End If      
          End If
        End If
        
      End If
      
      
      If LApplyFlag Then
        ' add the surcharge
        FSurchargeTotal = GetSurchargeTotal(FDeliveryCostExSurcharge)
        LInterpolatedDeliveryCost = Round2dp(FDeliveryCostExSurcharge + FSurchargeTotal)
        
        ' use interpolated delivery cost if applicable
        If FInterpolateCost Then  
          FDeliveryCostTotal = LInterpolatedDeliveryCost 
        End If
        
        ' if applicable then interpolate the charge using interpolated delivery cost
        ' if charge not interpolated then it use the original setting of GetDeliveryFromTable_ above 
        If FInterpolateCharge Then
          FMarkupTotal = GetMarkupTotal(LInterpolatedDeliveryCost, FMarkupPC, FMarkupAmount) ' markup 1 used instead of markup 2 deliberately           
          LResult = Round2dp(LInterpolatedDeliveryCost + FMarkupTotal)  
        End If
      End If
      
    End If
    
    ' (SS,24/7/25) topup to meet minimum charge
    LResult = Round2dp(LResult + GetMinChargeTopup(LResult))
    
    GetDeliveryFromTable_ = LResult
     
  End Function

 ' Private Function GetSurchargeTotal_old(ADeliveryCost, ASurchargePC, ASurchargeAmount)    
   ' Response.Write "GetSurchargeTotal: ADeliveryCost=" & ADeliveryCost & ", ASurchargePC=" & ASurchargePC & ", ASurchargeAmount=" & ASurchargeAmount & BR
   ' Response.Write "GetSurchargeTotal=" & Round2dp((ADeliveryCost + ASurchargeAmount) * (ASurchargePC / 100)  + ASurchargeAmount) & BR
 '   GetSurchargeTotal = Round2dp((ADeliveryCost + ASurchargeAmount) * (ASurchargePC / 100) + ASurchargeAmount)
 ' End Function
  
  ' (SS,14/4/25) new version, that uses a fixed calc rather than from tables
  ' (SS,19/6/25) removed ValueSurcharge, which is now part of markup
  ' (SS,30/3/26) increased FuelSurcharge form 30% to 33%
  Private Function GetSurchargeTotal(ADeliveryCost)
    Dim LLengthOutOfGuage, LFuelSurchargePct
    LLengthOutOfGuage = Max(FBoxLengthMax, FPostalTubeLengthMax) > 121
    
    If IsInternational And IsFedEx Then
      ' (SS,30/3/26) increased from 30 to 33%
      ' (SS,1/4/26) replaced 33 with GetInternationalFuelSurchargePercentage
      FFuelSurcharge = Round2dp(ADeliveryCost * GetInternationalFuelSurchargePercentage / 100)
      ' package for FedEx exceeds 121cm on longest side
      If LLengthOutOfGuage Then
        FAdditionalHandlingSurcharge = 35
      Else
        FAdditionalHandlingSurcharge = 0
      End If
      GetSurchargeTotal = Round2dp(FFuelSurcharge + FAdditionalHandlingSurcharge)
    ElseIf IsUK And IsDHL Then
      ' package for DHL exceeds 121cm on longest side
      If LLengthOutOfGuage Then
        FAdditionalHandlingSurcharge = 6.50 ' (SS,25/2/26) adjusted from 3 to 6.50
        LFuelSurchargePct = 10.55
      Else
        FAdditionalHandlingSurcharge = 0
        LFuelSurchargePct = 8.13
      End If
      
      ' using 10.6% on top of cost inc above handling change, can be less or more depending on destination, can be more, now PC set above was 10.6
      FFuelSurcharge = Round2dp((ADeliveryCost + FAdditionalHandlingSurcharge) * LFuelSurchargePct / 100)
      GetSurchargeTotal = Round2dp(FFuelSurcharge + FAdditionalHandlingSurcharge)
    Else
      FFuelSurcharge = 0
      FAdditionalHandlingSurcharge = 0
      GetSurchargeTotal = 0
    End If
  End Function

  ' (SS,28/5/25)
  ' (SS,19/6/25) renamed to ValueMarkup
  Private Function ValueMarkup
    Dim LResult, LThreshold
    ' apply when value above £200, and apply to amount above at 0.5%
    ' (SS,23/7/25) modified to any a value and 0.6%
    LThreshold = 0 ' was 200
    If TotalValueExcVAT > LThreshold Then
      LResult = Round2dp((TotalValueExcVAT - LThreshold) * 0.006) ' was 0.005
    Else
      LResult = 0
    End If
    ValueMarkup = LResult
  End Function

  ' (SS,19/6/25) added ValueMarkup
  Private Function GetMarkupTotal_old(ADeliveryCost, AMarkupPC, AMarkupAmount)
    GetMarkupTotal_old = Round2dp(ADeliveryCost * (AMarkupPC / 100) + AMarkupAmount + ValueMarkup)
  End Function
  
  ' (SS,19/6/25) added ValueMarkup
  ' (SS,21/7/25) modified to ensure minimum amount for Royal Mail
  Private Function GetMarkupTotal(ADeliveryCost, AMarkupPC, AMarkupAmount)  
    ' (SS,21/7/25) calc markup, as before
    Dim LMarkupTotal, LMarkupPCAmount
    LMarkupPCAmount = Round2dp(ADeliveryCost * (AMarkupPC / 100))
    
    ' (SS,24/7/25) useful info for debug log
    FMarkupPCInfoForLog = AMarkupPC & "% of " & ADeliveryCost & " = " & LMarkupPCAmount
    
    LMarkupTotal = Round2dp(LMarkupPCAmount + AMarkupAmount + ValueMarkup)

    GetMarkupTotal = LMarkupTotal
  End Function

  ' (SS,24/7/25) separated from GetMarkupTotal
  ' (SS,21/7/25) ensure minimum charge for Royal Mail by adding a topup
  Private Function GetMinChargeTopup(ADeliveryCharge)
    FMinChargeTopUp = 0
    If IsRoyalMail Then
      If IsUK Then
        FMinDeliveryCharge = ROYAL_MAIL_MIN_CHARGE_UK
      Else
        FMinDeliveryCharge = ROYAL_MAIL_MIN_CHARGE_INTERNATIONAL
      End If
      If ADeliveryCharge < FMinDeliveryCharge Then
        FMinChargeTopUp = Round2dp(FMinDeliveryCharge - ADeliveryCharge)
      End If
    End If
    GetMinChargeTopup = FMinChargeTopUp
  End Function
  
  Private Function GetInterpolatedDeliveryCost(AActualWeight, AHighWeight, ALowWeight, AHighCost, ALowCost)    
    Dim LWeightDiff, LCostDiff, LWeightRatio
    LWeightDiff = AHighWeight - ALowWeight
    LCostDiff = AHighCost - ALowCost 
    LWeightRatio = (AActualWeight - ALowWeight) / LWeightDiff
    GetInterpolatedDeliveryCost = Round2dp(ALowCost + (LCostDiff * LWeightRatio))
  End Function
  
  ' returns true if tracked Royal Service OTA is cheaper than standard OLA
  ' only RM international is checked
  Private Function IsRoyalMailTrackedCheaperThanStandard
    Dim LResult, LDeliveryCostFromTableOLA, FDeliveryCostFromTableOTA, LWeightUpTo, LInterpolateCharge, LInterpolateCost, LMarkupPC, LMarkupAmount   
    LResult = False
    If GetDeliveryTableValues(DeliveryCalcWeight, False, False, "OLA", PackageSize, LDeliveryCostFromTableOLA, LWeightUpTo, LInterpolateCharge, LInterpolateCost, LMarkupPC, LMarkupAmount) Then
      If GetDeliveryTableValues(DeliveryCalcWeight, False, False, "OTA", PackageSize, FDeliveryCostFromTableOTA, FWeightUpTo, LInterpolateCharge, LInterpolateCost, FMarkupPC, FMarkupAmount) Then
        LResult = FDeliveryCostFromTableOTA <= LDeliveryCostFromTableOLA
      End If    
    End If
    IsRoyalMailTrackedCheaperThanStandard = LResult
  End Function
  
  ' AService parameter, added to allow price comparison with different services
  ' (SS,12/6/25) ByRef APackageSize removed, now uses PackageType property, and doesn't send it back
  ' (SS,18/6/25) PackageType renamed back to PackageSize
  ' (SS,26/6/25) Replaced AInterpolate with AInterpolateCharge, and added  AInterpolateCost, TotalGrossWeight with DeliveryCalcWeight in code below
  ' (SS,21/7/25) added APackageSize, not used when it's blank, used for RM to ignore it when interpolating
  ' (SS,21/7/25) added ANext, to allow > instead of >= used for Royal Mail special interpolation)
  ' (SS,21/7/25) also added ATotalWeight because we might be searching for next WeightUpTo i.e. special Royal Mail interpolatation, this replaces DeliveryCalcWeight in code below
  Private Function GetDeliveryTableValues(ATotalWeight, ANext, APrevious, AService, APackageSize, ByRef ADeliveryCostFromTable, ByRef AWeightUpTo, ByRef AInterpolateCharge, ByRef AInterpolateCost, ByRef AMarkupPC, ByRef AMarkupAmount)
    Dim LSQL, LCondition, LAscOrDesc
    
    ' APrevious is applicable for interpolation, used to get the previous record
    If APrevious Then
      LCondition = " < "
      LAscOrDesc = "DESC"
    ElseIf ANext Then
      LCondition = " > "
      LAscOrDesc = "ASC"
    Else
      LCondition = " >= "
      LAscOrDesc = "ASC"
    End If
        
    ' Response.Write "###GetDeliveryTableValues: Service: " & FRegionCode & ", " & AService & ", Courier: " & Courier & ", TotalAdjustedWeight: " & TotalGrossWeight & ", APackageType: " & APackageType & "###" & BR
    
    ' (SS,14/5/25) added PackageSize to ORDER BY fix issue where Large Letter wasn't being chosen in table deliverycosts_int_rm when weight less or equal to 100g
    ' (SS,12/6/25) added renamed PackageSize to PackageType, added PackageType to WHERE
    ' (SS,18/6/25) renamed PackageType back to PackageSize
    ' (SS,26/6/25) renamed Interpolate to InterpolateCharge and added InterpolateCost
    LSQL = "SELECT Agent, Courier, Service, MarkupPC, MarkupAmount, PackageSize, InterpolateCharge, InterpolateCost, WeightUpTo, " + FDeliveryZoneField &_
      " FROM " + FDeliveryTableName &_
      " WHERE Enabled AND Courier = '" & Courier & "' AND Service = '" & AService & "' " & " AND COALESCE(PostalTubeMax, 0) >= " & PostalTubeLengthMin & " AND WeightUpTo" & LCondition & ATotalWeight

    ' (SS,21/7/25) only use APackageSize if not ""
    If APackageSize <> "" Then
      LSQL =  LSQL + " AND PackageSize = '" & APackageSize & "'"  
    End If
    
    LSQL = LSQL + " ORDER BY Agent, Courier, Service, PackageSize, WeightUpTo " & LAscOrDesc & " LIMIT 1"  

    ' save SQL statement for debug logging
    If APrevious Or ANext Then
      FSQL2 = LSQL
    Else
      FSQL = LSQL
    End If

    OpenQuery2(LSQL)
    If Not EndOfQuery2 Then
      GetDeliveryTableValues = True      
      ADeliveryCostFromTable = CDbl(GetQueryValue2(FDeliveryZoneField))
      AWeightUpTo = CDbl(GetQueryValue2("WeightUpTo"))
      ' APackageType = GetQueryValue2("PackageType")
      AInterpolateCharge = IntToBool(GetQueryValue2("InterpolateCharge"))
      AInterpolateCost = IntToBool(GetQueryValue2("InterpolateCost")) ' (SS,26/6/25)
      AMarkupPC = CDbl(GetQueryValue2("MarkupPC"))
      AMarkupAmount = CDbl(GetQueryValue2("MarkupAmount"))
    Else
      GetDeliveryTableValues = False
    End If

 '   Response.Write "#LSQL: " & LSQL & "###" & BR
 '   Response.Write "###2.GetDeliveryTableValues: Service: " & AService & ", TotalAdjustedWeight: " & TotalAdjustedWeight & ", APackageType: " & APackageType & "###" & BR
    
    CloseQuery2
    
  End Function
  
  Public Property Let LogTypeHTML(AValue)
    FLogTypeHTML = AValue
  End Property  

  Public Property Get LogTypeHTML
    LogType = FLogTypeHTML
  End Property    
  
  Sub AddLog(AName, AValue)
    If FLogTypeHTML Then
      FLog = FLog & "<tr class=""small""><th>" & AName & "</th><td>" & AValue & "</td></tr>"
    Else
      If FLog <> "" Then FLog = FLog & BR
      If AName <> "" Then 
        FLog = FLog & AName & " = " & AValue
      End If
    End If
  End Sub
  
  Sub DebugLogDeliveryTableLink(AText, ATableName)
    AddLog AText, "<a href=""" & GetStoreURL + "/delivery-table-show.asp?dtn=" + ATableName + """ target=""_blank"">" & AText & "</a>"
  End Sub
  
  Public Property Get DebugLog
    
    ' (SS,22/7/25)
    If Session("CheckModeOrderNo") <> "" Then    
      AddLog "CheckModeOrderNo", Session("CheckModeOrderNo")
    End If
    
    AddLog "TotalValue", FTotalValue
    AddLog "VATContent", FVATContent
    AddLog "TotalValueExcVAT", TotalValueExcVAT    
    AddLog "TotalWeight", FTotalWeight
    AddLog "Country", FCountry
    AddLog "RegionCode", FRegionCode 
    AddLog "IsUK", IsUK
    AddLog "IsUKMain", IsUKMain    
    AddLog "IsUKIslands", IsUKIslands   
    AddLog "IsInternational", IsInternational     
    
    AddLog "", ""
    
    AddLog "PostalTubeLengthMax", FPostalTubeLengthMax
    AddLog "BoxLengthMax", FBoxLengthMax
    AddLog "BoxHeightMax", FBoxHeightMax
    AddLog "HasLiPo", FHasLiPo
    AddLog "RCModelCount", RCModelCount
    AddLog "PostalTubeToBoxUpgradeApplicable", PostalTubeToBoxUpgradeApplicable    
    
    AddLog "", ""
    
    AddLog "TotalWeight", FTotalWeight
    ' AddLog "AdjustedWeightRCModels", FAdjustedWeightRCModels
    AddLog "ContentWeight", ContentWeight
    
    'AddLog "AdditionalWeightPostalTube", FAdditionalWeightPostalTube
    ' (SS,28/5/25) replaced above with following
    AddLog "PackagingWeight", FPackagingWeight
    
    AddLog "GrossWeight", FGrossWeight
    AddLog "TubeVolumetricWeight", FTubeVolumetricWeight
    AddLog "BoxVolumetricWeight", FBoxVolumetricWeight 
    AddLog "MaxVolumetricWeight", FMaxVolumetricWeight
    AddLog "BoxLengthList", FBoxLengthList
    AddLog "BoxVolumetricWeightList", FBoxVolumetricWeightList
    AddLog "MaxBoxVolumetricWeight", FMaxBoxVolumetricWeight
    AddLog "TotalBoxVolumetricWeight", FTotalBoxVolumetricWeight 
    AddLog "AdjustedBoxVolumetricWeight", FAdjustedBoxVolumetricWeight 

    AddLog "BoxHeightList", FBoxHeightList
    
    AddLog "VolumetricWeight", FVolumetricWeight
    AddLog "DeliveryCalcWeight", DeliveryCalcWeight ' (SS,26/6/25) was TotalGrossWeight
    AddLog "EstimatedGrossWeight", EstimatedGrossWeight 
    AddLog "EstimatedVolumetricWeight", EstimatedVolumetricWeight 
    
    AddLog "", ""

    AddLog "CountryOptions", FCountryOptions
    AddLog "CountryLiPoAllowed", FCountryLiPoAllowed
    AddLog "CountryRoyalMailAllowed", FCountryRoyalMailAllowed
    AddLog "CountryTrackedOnly", FCountryTrackedOnly    
    
    AddLog "RMPreferredServiceCode", FRMPreferredServiceCode
    AddLog "RMZone", FRMZone
    AddLog "FedExZone", FFedExZone
    
    AddLog "", ""    
    
    AddLog "StandardSelected", FStandardSelected
    AddLog "TrackedSelected", FTrackedSelected
    AddLog "ExpeditedSelected", FExpeditedSelected
    AddLog "TrackedAuto", FTrackedAuto
    AddLog "RoyalMailApplicable", RoyalMailApplicable     
    AddLog "TrackedApplicable", TrackedApplicable
    AddLog "RMTrackedCheaperThanStandard", FRoyalMailTrackedCheaperThanStandard
    
    
    AddLog "GetDeliveryMethod", GetDeliveryMethod
    AddLog "IsDefaultDeliveryMethodSelected", IsDefaultDeliveryMethodSelected   
    AddLog "DefaultDeliveryMethodSelected", GetDefaultDeliveryMethodSelected  
   ' AddLog "GetDeliveryMethodChanged", GetDeliveryMethodChanged  
    
    AddLog "", ""
    
    AddLog "Agent", Agent
    AddLog "Courier", Courier
    AddLog "Service", Service
    AddLog "Priority", Priority
    
    AddLog "", ""

    AddLog "DeliveryTableName", FDeliveryTableName 
    AddLog "DeliveryZoneField", FDeliveryZoneField
    AddLog "PackageSize", PackageSize
    AddLog "PackageName", PackageName  
    
    AddLog "WeightUpTo", FWeightUpTo    
    AddLog "DeliveryCostFromTable", FDeliveryCostFromTable
    AddLog "DeliveryCostExSurcharge", FDeliveryCostExSurcharge
    If IsInternational Then AddLog "InternationalFuelSurchargePercentage", GetInternationalFuelSurchargePercentage & "%" ' (SS,1/4/26)
    AddLog "FuelSurcharge", FFuelSurcharge
    AddLog "AdditionalHandlingSurcharge", FAdditionalHandlingSurcharge
    AddLog "SurchargeTotal", FSurchargeTotal
    AddLog "DeliveryCostTotal", FDeliveryCostTotal    
    AddLog "DeliveryCalculatedCost", DeliveryCalculatedCost ' (SS,19/6/25)
    AddLog "MarkupPC", FMarkupPCInfoForLog ' (SS,24/7/25) replaced FMarkupPC with FMarkupPCInfoForLog 
    AddLog "MarkupAmount", FMarkupAmount
    AddLog "ValueMarkup", ValueMarkup
    AddLog "MarkupTotal", FMarkupTotal

    AddLog "MinDeliveryCharge", FMinDeliveryCharge ' (SS,24/7/25)
    AddLog "DeliveryChargeBeforeTopUp", Round2dp(FDeliveryCharge - FMinChargeTopUp) ' (SS,24/7/25)
    AddLog "MinChargeTopUp", FMinChargeTopUp ' (SS,24/7/25)

    AddLog "DeliveryCharge", FDeliveryCharge
    AddLog "DeliveryChargeIncVAT", Round2dp(FDeliveryCharge * 1.2)
    
    AddLog "", ""
    AddLog "Interpolate Charge", FInterpolateCharge
    AddLog "Interpolate Cost", FInterpolateCost
    If FInterpolateCharge Or FInterpolateCost Then
      AddLog "WeightUpTo2", FWeightUpTo2   
      AddLog "DeliveryCostFromTable2", FDeliveryCostFromTable2    
     ' AddLog "MarkupPC2", FMarkupPC2
     ' AddLog "MarkupAmount2", FMarkupAmount2      
    End If
    
    AddLog "", ""
    
    DebugLogDeliveryTableLink "Countries Table", "countries"    
    DebugLogDeliveryTableLink "UK Table", "deliverycosts_uk"
    DebugLogDeliveryTableLink "International RM Table", "deliverycosts_int_rm"
    DebugLogDeliveryTableLink "International FedEx Table", "deliverycosts_int_fedex"
    DebugLogDeliveryTableLink "Delivery Package Names", "delivery_package_names"
    
    AddLog "", ""
    
    AddLog "SQL", FSQL
    
    If FSQL2 <> "" Then AddLog "SQL2", FSQL2
    
    If Not FLogTypeHTML Then AddLog "", ""
    
    If FLogTypeHTML Then
      Dim LHTML
      
      LHTML = "<div class=""col-lg-12"">"
      
      LHTML = LHTML + "<button style=""margin-bottom:20px"" class=""btn btn-info"" type=""button"" data-toggle=""collapse"" data-target=""#debuglog"" aria-expanded=""false"" aria-controls=""debuglog"">Show delivery calculation</button>"
    
      FLog = "<table class=""table table-responsive table-condensed table-striped"">" & FLog & "</table>"
      
      LHTML = LHTML + "<div class=""collapse"" id=""debuglog"">" + FLog + "</div>"
      LHTML = LHTML + "</div>"
      
      FLog = LHTML
    End If
    
    DebugLog = FLog
  End Property
  
  
End Class

%>