File: D:/web/hyperflight/! previous changes 2/2025-07-28/prev/customutils-delivery-charge-class.asp
<%
' =====================================
' customutils-delivery-charge-class.asp
' =====================================
' Version 1.00 (24/07/25)
' ============
' HISTORY
' ============
' (SS,24/07/25) First used, included from customutils-delivery.asp used for new HyperFlight delivery calculation
' (SS,5/4/2025)
Class cDeliveryCharge
Private FObjectName
Private FIsDataFeedMode ' true when data feed mode i.e. while creating Google shopping data feed
Private FCountry, FRegionCode
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 = ""
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
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 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
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
'Private Function GetPackagingWeight(ALength, AHeight, AIsLargeLetter, AIsTube, AIsTubeVolumetric, ByRef AWeightIsVolumetric)
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"
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
AttributeOrCatInBasketCallback "Minimum Box Length", "MinimumBoxLength", FObjectName + ".BoxLengthAttributeBasketCallback"
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
AttributeOrCatInBasketCallback "Minimum Box Height", "MinimumBoxHeight", FObjectName + ".BoxHeightAttributeBasketCallback"
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 FIsDataFeedMode 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", "")
' 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 If
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
If IsExpedited 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
Private Property Get RoyalMailApplicable
Dim LResult
If IsUK Then
If IsUKMain Then
LResult = FGrossWeight <= ROYAL_MAIL_MAX_WEIGHT_UK_MAIN
Else ' i.e. UKIslands
LResult = FGrossWeight <= ROYAL_MAIL_MAX_WEIGHT_UK_ISLANDS
End If
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
If FGrossWeight <= ROYAL_MAIL_LARGE_LETTER_MAX_WEIGHT And FBoxHeightMax <= 2.5 And Not HasPostalTube And Courier = "Royal Mail" Then
PackageSizeIsLargeLetter = True
Else
PackageSizeIsLargeLetter = False
End If
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
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
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 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
Private Function GetSurchargeTotal(ADeliveryCost)
Dim LLengthOutOfGuage, LFuelSurchargePC
LLengthOutOfGuage = Max(FBoxLengthMax, FPostalTubeLengthMax) > 121
If IsInternational And IsFedEx Then
FFuelSurcharge = Round2dp(ADeliveryCost * 30 / 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 = 3
LFuelSurchargePC = 10.55
Else
FAdditionalHandlingSurcharge = 0
LFuelSurchargePC = 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) * LFuelSurchargePC / 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
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"">Debug log</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
%>