File: D:/web/hyperflight/customutils.asp
<!--#include file="customutils-delivery.asp"-->
<%
' ==============
' customutils.asp
' ==============
' Version 1.60 (20/07/26)
' ============
' HISTORY
' ============
' (SS,12/09/05) First created
' (SS,21/07/10) Added CustomGetStockInfo
' (SS,05/07/12) Extra delivery for carbon rod products
' (NS,11/08/12) Additional delivery for single small carbon rod product
' (SS,04/10/12) CustomGetDelivery now uses GetAttributeInBasketMaxOptionValue
' (NS,11/08/12) global added to allow removed of delivery info in inc-template-messages
' (SS,18/01/13) Added Sub CustomShuffledLeftMenuItems to show items on left menu in shuffled order
' (SS,08/03/13) Change to CustomGetStockInfo to split "Out of stock but available to pre-order" into two lines
' (SS,20/12/13) Added Function CustomVATNumberHelpMessage
' (SS,09/12/14) Added AByPriceDeliveryCost, AByWeightDeliveryCost to CustomGetDelivery to make compatible with latest apputils
' (SS,01/02/16) Added GetPleaseContactForAvailabilityInfo to CustomGetStockInfo to place after "Out of stock"
' (SS,01/12/16) Added setting of order priority via changes to Function CustomGetDelivery and new Function CustomGetPriority
' (SS,08/03/17) Modified CustomGetDelivery to remove VAT from Value for Priority calculation
' (SS,24/05/17) Added Sub CustomShowHolidayNotice(AType, AProductID) for holiday notices (originally (SS,28/11/14) from CIRC)
' (SS,09/06/17) Custom function for product option, only for radio (Function CustomGetProductOptionValueHTML)
' (SS,20/07/17) Added Function CustomShowBankTransferModal and Sub CustomShowBankTransferBank for new bank transfer modal
' (SS,25/07/17) Improvements to Lipo delivery cost calculation in CustomGetDelivery
' (SS,25/08/17) Change to Function CustomGetStockInfo to use GetActiveProductCode instead of GetProductCode to use notify me link for related products
' (SS,12/09/17) Change to Function CustomShowBankTransferModal to only show one option for GBP if currency other than GBP, EUR and USD chosen
' (SS,29/09/17) Change to Function CustomShowBankTransferModal added BillingCountry parameter, and modified the currency options shown
' (SS,31/10/17) Adjustment to postal tube delivery for EU, EU2 and RW (Function CustomGetDelivery)
' (SS,02/11/17) Minor adjustment to priority 3 in Function CustomGetDelivery
' (SS,26/01/18) Minor change to priority in Function CustomGetDelivery
' (SS,02/02/18) Very minor change to priority in Function CustomGetDelivery
' (SS,20/04/18) Change to Bank Transfer payment button size and colour in Function CustomShowBankTransferModal and CustomShowBankTransferBank
' (SS,28/06/18) Modified Function CustomGetDelivery to add delivery option code for tracked delivery
' (SS,29/06/18) Minor change to CustomGetDelivery, for tracked delivery it's 4.17 (not 5.00)
' (SS,16/07/18) Change to priority when tracked delivery chosen Function CustomGetDelivery
' (SS,09/08/18) Change to CustomGetDelivery to force tracked also when weight is 1500g or over. Also additional tracked delivery addtional charge from �5 to �6.50.
' (SS,15/02/19) Change to Function CustomGetDelivery: Priority 7, changed to use grand total value not excluding VAT Value (requested by Deborah)
' (SS,11/06/20) Changed "Deutsche Handelsbank" to "TransferWise" in Function CustomShowBankTransferModal, added new account changed alert message for EU to Sub CustomShowBankTransferBank
' (SS,02/10/20) Added rel="nofollow" to CustomGetStockInfo, also improvement to show discontinued and link to replaced by product instead of Out of stock message
' (SS,21/01/21) Added bank transfer image to Function CustomShowBankTransferModal
' (SS,22/04/21) Change to CustomGetDelivery to add expedited delivery option, this adds an extra 30% to the delivery cost
' (SS,22/04/21) Updated expedited delivery extra cost from 30% to 75%, also changed to ensure priority of at least 5 for expedited
' (SS,26/04/21) Correction to Function CustomGetDelivery, due to extra 5.42 being charged incorrectly for tracked when
' (SS,29/04/21) Change to Function CustomGetDelivery to improve DeliveryOption setting
' (SS,30/04/21) Modified CustomGetDelivery to call GetWeightRangeForCategory (new function in apputils.asp) reduced delivery for multiple RC Models
' (SS,05/05/21) Modified GetDeliveryFromTable (in apputils.asp) to interpolate delivery costs from delivery costs tableFunction CustomGetDelivery
' (SS,06/05/21) Modified CustomGetDelivery to restrict LiPo to specific countries (previous setting was for region RW, LA, or USA)
' (SS,07/05/21) Modified CustomGetDelivery, call to SetAdjustedTotalWeight to set the adjusted total weight
' (SS,10/05/21) Modified CustomGetDelivery - added check for delivery cost of <= 0 to abort, or >= 20000 and not UK to abort with error
' (SS.12/05/21) Modified CustomGetDelivery - change to call to GetWeightRangeForCategory to remove RC_MODEL_MEDIUM_REF_WEIGHT and replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
' (SS,06/06/21) Modified CustomGetDelivery to fixed issue with Google Shopping Data Feed by not calling GetWeightRangeForCategory when in DoGoogleShoppingDataFeed
' (SS,11/06/21) Modified CustomGetDelivery to fix bug where Tracked was overriding Expedited delivery option, also set priority to 9 for expedited
' (SS,11/06/21) Modified CustomGetDelivery - bug fix for Google Shopping Data Feed to ensure minimum UK delivery for all products
' (SS,01/07/21) Modified CustomGetDelivery to call new Sub CustomAddPriorityLog to log priority to help find issue where wrong priority is sometimes being set, also added Function CustomGetAdditionalLockTables
' (SS,01/03/22) Modified Sub CustomShowBankTransferBank, removed the bank account changed message
' (SS,20/06/22) Changed width of button in Function CustomShowBankTransferModal
' (SS,23/06/22) Change to Function CustomShowBankTransferModal to optionally show preferred text
' (SS,11/07/22) new versions of CustomGetDelivery, keeping original, new refactored, new algorithm version
' (SS,05/10/22) modified to call CustomGetDeliveryNewAlgorithmV2
' (SS,06/10/22) modified to call CustomGetDeliveryOriginal last
' (SS,23/02/23) Bug fix to Sub CustomAddPriorityLog to allow '' passed on as a value to be saved as a NULL
' (SS,08/03/23) Modified Function CustomGetDelivery to remove for now for CustomIsLocalPC by added And False
' (SS,19/04/23) IP address change in Function CustomIsLocalPC
' (SS,21/03/25) New CustomGetRoyalMailDeliveryCost and CustomGetDeliveryNewAlgorithmV3
' (SS,26/03/25) modified CustomGetDelivery to use CustomGetDeliveryRefactored instead of CustomGetDeliveryOriginal, which make use of CustomGetRoyalMailDeliveryCost when applicable
' (SS,26/03/25) Change to Function CustomGetRoyalMailDeliveryCost to assume large letter if weight is 96g or less
' (SS,27/03/25) New Function CustomGetDeliveryNewAlgorithmV4
' (SS,28/03/25) Removed older versions, new NewAlgorithmV4 is now the only one
' (SS,07/04/25) New version using latest algorithm, just a single include file customutils-delivery.asp
' Replacing the following: CustomGetDeliveryOriginal.asp, CustomGetDeliveryRefactored.asp, CustomGetDeliveryNewAlgorithm.asp, CustomGetDeliveryNewAlgorithmV2.asp, CustomGetDeliveryNewAlgorithmV3.asp, CustomGetDeliveryNewAlgorithmV4.asp
' (SS,28/08/25) Added Function CustomGoogleShoppingDeliveryOverride to override delivery cost for Google Shipping feed
' (SS,31/08/25) Changes to Function CustomGoogleShoppingDeliveryOverride, added Dim csGoogleShoppingFeedEmailBody
' (SS,02/09/25) Changes to Function CustomGoogleShoppingDeliveryOverride, added AAvailability, also added courier, service, package size and name to HTML output
' (SS,08/09/25) Changes to Function CustomGoogleShoppingDeliveryOverride, added country, currency parameters, also datatables for better viewing with table type
' (SS,10/09/25) Improvements to Function CustomGoogleShoppingDeliveryOverride
' (SS,12/09/25) Modified Function CustomGoogleShoppingDeliveryOverride to only include the table in the email for UK, US & FR
' (SS,29/07/26) Added Function CustomProductDeliveryAllowed for restricted delivery items i.e. LiPo batteries and glue
' (SS,31/8/25) cs prefix for custom variables
Dim csGoogleShoppingFeedEmailBody, csGoogleShoppingFeedCount, csGoogleShoppingContentTypeIsText, csGoogleShoppingContentTypeIsTable, csGoogleShoppingRegionCode
' (SS,12/5/26)
Function CustomInitialise
SetBootstrap5
CustomInitialise = True
End Function
' this routine must exist if CustomDeliveryEnabled, -1 is returned if delivery cost could not be determined, user should be alerted using SetAlertMessage
' (SS,5/7/12) custom delivery to charge extra if carbon rod type item in basket (i.e. with "Postal Length" attribute >=90 and any option value is >= 90)
' (SS,4/10/12) replaced GetAttributeInBasketCountNumValCompare with GetAttributeInBasketMaxOptionValue which returns maximum option value
' (SS,9/12/14) added AByPriceDeliveryCost, AByWeightDeliveryCost to make compatible with latest apputils
' (SS,1/12/16) added setting of Priority for order, N.B. this routine isn't called if "delivery will collect", custom routine CustomGetPriority will always be called (see below) this can be used to set priority for "delivery will collect"
' (SS,8/3/17) modified to remove VAT from Value for Priority calculation
' (SS,25/7/17) improvements to Lipo delivery cost calculation
' (SS,31/10/17) adjustment to postal tube delivery for EU, EU2 and RW
' (SS,2/11/17) adjustment to priority 3
' (SS,26/1/18) minor change to priority
' (SS,28/6/18) modified to add delivery option code for tracked delivery
' (SS,16/7/18) change to priority when tracked delivery chosen
' (SS,15/2/19) Priority 7, changed to use grand total value not excluding VAT Value (requested by Deborah)
' (SS,22/4/21) added expedited delivery option, this adds an extra 30% to the delivery cost
' (SS,26/4/21) correction, due to extra 5.42 being charged incorrectly for tracked
' (SS,30/4/21) modified to call GetWeightRangeForCategory for reduced delivery for multiple RC Models
' (SS,05/5/21) modified GetDeliveryFromTable (in apputils.asp) to interpolate delivery costs from delivery costs table
' (SS,06/5/21) change to restrict LiPo to specific countries (previous setting was for region RW, LA, or USA)
' (SS,07/5/21) added call to SetAdjustedTotalWeight to set the adjusted total weight
' (SS,10/5/21) added check for delivery cost of <= 0 to abort, or >= 20000 and not UK to abort with error
' (SS,12/5/21) modified call to GetWeightRangeForCategory to remove RC_MODEL_MEDIUM_REF_WEIGHT and replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
' (SS,03/6/21) fixed issue with Google Shopping Data Feed by not calling GetWeightRangeForCategory when in DoGoogleShoppingDataFeed
' (SS,11/6/21) bug fix to Tracked overriding Expedited delivery option, also set priority to 9 for expedited
' (SS,11/6/21) bug fix for Google Shopping Data Feed to ensure minimum UK delivery for all products
' (SS, 8/7/22) new verison, rewrite, actual routines in CustomGetDeliveryOriginal.asp
' (SS,11/7/22) refactored version in CustomGetDeliveryRefactored.asp
' (SS,11/7/22) new algorithm in CustomGetDeliveryNewAlgorithm.asp
' (SS,11/7/22) modified to call CustomGetDeliveryOriginal, CustomGetDeliveryRefactored or CustomGetDeliveryNewAlgorithm
' (SS,5/10/22) modified to call CustomGetDeliveryNewAlgorithmV2
' (SS,6/10/22) modified to call CustomGetDeliveryOriginal last
' (SS,8/03/23) modified to remove for now for CustomIsLocalPC by added And False
' (SS,26/3/25) modified to use CustomGetDeliveryRefactored instead of CustomGetDeliveryOriginal, which make use of CustomGetRoyalMailDeliveryCost when applicable
' (SS,28/3/25) removed old versions, new version in customutils-delivery.asp named CustomGetDeliveryCharge
Function CustomGetDelivery(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
Dim LDelivery
LDelivery = CustomGetDeliveryCharge(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
CustomGetDelivery = LDelivery
End Function
' (SS,15/11/22) to show additional values for debugging
Sub CustomShowSetDeliveryVars(ANormalDelivery, AExtraDelivery, ADeliveryUplift, AMaxPackagedWeight, ATrackedDelivery, AExpeditedDelivery)
Session("CustomAdjustedWeight") = GetAdjustedTotalWeight
Session("CustomNormalDelivery") = ANormalDelivery
Session("CustomExtraDelivery") = AExtraDelivery
Session("CustomDeliveryUplift") = ADeliveryUplift
Session("CustomMaxPackagedWeight") = AMaxPackagedWeight
Session("CustomTrackedDelivery") = ATrackedDelivery
Session("CustomExpeditedDelivery") = AExpeditedDelivery
End Sub
' (SS,21/3/25)
Sub CustomShowSetRMDeliveryVars(ARoyalMailDelivery, ARoyalMailZone, ARoyalMailServiceCode, ARoyalMailBand)
Session("CustomRoyalMailDelivery") = ARoyalMailDelivery
Session("CustomRoyalMailZone") = ARoyalMailZone
Session("CustomRoyalMailServiceCode") = ARoyalMailServiceCode
Session("CustomRoyalMailBand") = ARoyalMailBand
End Sub
' (SS,21/3/25)
Sub CustomShowClearRMDeliveryVars
Session("CustomRoyalMailDelivery") = ""
Session("CustomRoyalMailZone") = ""
Session("CustomRoyalMailServiceCode") = ""
Session("CustomRoyalMailBand") = ""
End Sub
' (SS,11/7/22) used above
' (SS,21/3/25) added Royal Mail column
Sub CustomShowDeliveryTableRow(AName, Amount, AOriginalWeight)
Dim LHasLiPo, LPostalTubeMaxLength, LAdjustedWeight
LHasLiPo = GetAttributeInBasketCount("LiPo", "") > 0
LPostalTubeMaxLength = GetAttributeInBasketMaxOptionValue("Requires Postal Tube")
If IsAdjustedWeightSet Then
LAdjustedWeight = GetAdjustedTotalWeight
Else
LAdjustedWeight = AOriginalWeight
End If
%>
<tr>
<td><%=AName%></td><td><%=CorrectCurrencyActual(Amount, True)%></td><td><%=CorrectCurrencyWV(Amount)%></td>
<td><%=GetPriority%></td>
<td><%=iif(LHasLiPo, "<i class=""glyphicon glyphicon-ok""></i>", "")%></td>
<td><%=LPostalTubeMaxLength%></td>
<td><%=AOriginalWeight%></td>
<td><%=Session("CustomMaxPackagedWeight")%></td>
<td><%=LAdjustedWeight%></td>
<td><%=iif(Session("CustomTrackedDelivery"), "<i class=""glyphicon glyphicon-ok""></i>", "")%></td>
<td><%=iif(Session("CustomExpeditedDelivery"), "<i class=""glyphicon glyphicon-ok""></i>", "")%></td>
<td><%=CorrectCurrencyActual(Session("CustomNormalDelivery"), True)%></td>
<td><%=CorrectCurrencyActual(Session("CustomExtraDelivery"), True)%></td>
<td><%=CorrectCurrencyActual(Session("CustomDeliveryUplift"), True)%></td>
<td><%=CorrectCurrencyActual(Session("CustomRoyalMailDelivery"), True)%></td>
<td><%=Session("CustomRoyalMailZone")%></td>
<td><%=Session("CustomRoyalMailServiceCode")%></td>
<td><%=Session("CustomRoyalMailBand")%></td>
</tr>
<%
End Sub
' (SS,11/7/22) used above, returns True if IP address is HF/ITP office or SS Home
Function CustomIsLocalPC
Dim LIP
LIP = Request.ServerVariables("REMOTE_ADDR")
' (SS,19/4/23) changed "80.229.231.82" to new Drybank Full Fibre Plusnet IP "212.159.111.105"
CustomIsLocalPC = LIP = "192.168.1.2" Or LIP = "88.98.246.98" Or LIP = "212.159.111.105"
'CustomIsLocalPC = False
End Function
' (SS,1/7/21) to log value in priority log, used for debugging purposes
Sub CustomAddPriorityLog(APriority, APostcode, ARegionCode, ADeliveryRegion, ACountry, ATotalValue, ATotalWeight, ATotalItems, ANormalDeliveryCost, AExtraDeliveryCost, ADeliveryOption)
Dim LSQL
' (SS,23/2/23) added NNULL and removed quotes for ATotalValue, ATotalWeight, ATotalItems, ANormalDeliveryCost and AExtraDeliveryCost
' to overcome error: "Incorrect double value: '' for column `hyperflight`.`log_priority`.`TotalValue`, experienced by Neil after a product code rename
' NNULL converts '' to NULL, i.e. saved as a NULL into a DOUBLE field
LSQL = "INSERT INTO log_priority SET DateTimeLogged = NOW()" &_
", SessionID = '" & GetSessionID & "'" &_
", OrderNo = '" & GetOrderNo & "'" &_
", Priority = '" & CleanSQLStr(APriority) & "'" &_
", Postcode = '" & CleanSQLStrMax(APostcode, 20) & "'" &_
", RegionCode = '" & CleanSQLStrMax(ARegionCode, 20) & "'" &_
", DeliveryRegion = '" & CleanSQLStrMax(ADeliveryRegion, 20) & "'" &_
", Country = '" & CleanSQLStrMax(ACountry, 20) & "'" &_
", DeliveryOption = '" & CleanSQLStrMax(ADeliveryOption, 255) & "'" &_
", TotalValue = " & NNULL(ATotalValue) &_
", TotalWeight = " & NNULL(ATotalWeight) &_
", TotalItems = " & NNULL(ATotalItems) &_
", NormalDeliveryCost = " & NNULL(ANormalDeliveryCost) &_
", ExtraDeliveryCost = " & NNULL(AExtraDeliveryCost)
ExecuteQuery LSQL
End Sub
' (SS,1/7/21) added following for additonal table locks, i.e. log_priority for call to CustomAddPriorityLog in CustomGetDelivery
' without this the main ProcessOrder routine will fails, due to all tables access need to be locked
' (SS,11/7/22) added new table "deliverycosts_extra READ" used by new algorithm for CustomGetDelivery
Function CustomGetAdditionalLockTables
CustomGetAdditionalLockTables = "log_priority WRITE, deliverycosts_extra READ"
End Function
' (SS,1/12/16)
Function CustomGetPriority
Dim LResult
If GetDeliveryWillCollect Then
LResult = 0
Else ' return the existing priority already set in CustomGetDelivery above
LResult = GetPriority
End If
CustomGetPriority = LResult
End Function
' (SS,21/3/25)
' (SS,26/3/25) added weight/cost adjust and large letter if weight is 96g or less
Function CustomGetRoyalMailDeliveryCost(ACountry, AIsTracked, AWeightGrams)
Dim LResult, LWeightGrams, LRMZone, LServiceCode, LPackageSize, LIsUK
LResult = -1
' get zone, if blank then assume WZ1
LRMZone = GetSQLValueAsString("SELECT RMZone FROM Countries WHERE Country = '" + CleanSQLStr(ACountry) + "'")
If LRMZone = "" Then LRMZone = "WZ1"
LIsUK = IsUK(ACountry)
If LIsUK Then
LServiceCode = "CRL24"
Else
If AIsTracked Then
LServiceCode = "OTA"
Else
LServiceCode = "OLA"
End If
End If
LWeightGrams = AWeightGrams
' (SS,26/3/25) if 96g or less then assume large letter, before weight adjust ratio
' (SS,27/3/25) added If LIsUK And AIsTracked force "Parcel" for tracked for UK
If LWeightGrams <= 96 Then
If LIsUK And AIsTracked Then
LPackageSize = "Parcel"
Else
LPackageSize = "Large Letter"
End If
Else
LPackageSize = "Parcel"
End If
Dim LSQL, LDeliveryCost, LWeightBand
LWeightGrams = LWeightGrams * ROYAL_MAIL_WEIGHT_ADJUST_RATIO
LSQL = "SELECT " + LRMZone + ", WeightUpToGrams FROM " + CustomGetRoyalMainDeliveryCostTableName + " WHERE ServiceCode = '" + LServiceCode + "' AND PackageSize = '" + LPackageSize + "' AND WeightUpToGrams >= " & LWeightGrams
If Not GetSQL2Values(LSQL, LDeliveryCost, LWeightBand) Then
LResult = -1
End If
If LDeliveryCost = "" Then
LResult = -1
Else
LResult = CDbl(LDeliveryCost) * ROYAL_MAIL_COST_ADJUST_RATIO
End If
CustomShowSetRMDeliveryVars LDeliveryCost, LRMZone, LServiceCode, LWeightBand
CustomGetRoyalMailDeliveryCost = LResult
End Function
' (SS,21/3/25)
Function CustomGetRoyalMainDeliveryCostTableName
Dim LResult
If Date >= CDate("01/04/2025") Then
LResult = "deliverycosts_rm_25_04"
Else
LResult = "deliverycosts_rm_25_01"
End If
CustomGetRoyalMainDeliveryCostTableName = LResult
End Function
' (SS,20/7/10) called when there are no items in stock for current product
' (SS,11/7/22) moved this routine lower down, i.e. after CustomGetDelivery
Function CustomGetStockInfo(ADateStockDue, AAllowOutOfStockOrdering, AStockAvailabilityInfo)
'When the Date Stock Due field is blank or has a value older than 15 days ago
'Change text
' Delivery x to y days
'To
' Out of stock but available to preorder. Delivery in approx x to y days
'When the Date Stock Due field has a date greater than today
'Change text
' Currently out of stock, more due on <date>
'To
' Out of stock but available to preorder. Expected on <date>
'When the Date Stock Due field has a date less than today but greater than 15 days ago
'Change text
' Delivery x to y days
'To
' Out of stock but available to preorder. Expected soon.
Dim Result, LDaysDue
If IsNull(ADateStockDue) Then
LDaysDue = -16
Else
LDaysDue = DateDiff("d", Date, ADateStockDue)
End If
If AAllowOutOfStockOrdering Then
' (SS,8/3/13) changed from "Out of stock but available to pre-order" to the following, i.e. two lines
Result = "Out of stock"
Result = Result & BR & "Available to pre-order"
Else
' (SS,2/10/20) modified to show "Discontinued" for a discontinued product e.g. has discontinued in the product name
' if replaced by found then it adds the product code with hyperlink
Dim LProductCode
LProductCode = GetActiveProductCode ' N.B. use GetActiveProductCode to ensure it works for related products etc. (see 25/8/17 note below)
If ProductIsDiscontinued(LProductCode) Then
Result = "Discontinued"
Dim LProductName, LReplacedByPos, LReplacedByProductCode, LReplacedByProductCodeHyphenated
LProductName = GetProductNameNoHTMLEncode(LProductCode)
LReplacedByPos = InStr(1, LProductName, "replaced by ", vbTextCompare)
If LReplacedByPos > 0 Then
LReplacedByProductCode = Trim(Mid(LProductName, LReplacedByPos + 12, 99))
If LReplacedByProductCode <> "" Then
LReplacedByProductCodeHyphenated = ReplaceStr(LReplacedByProductCode, " ", "-")
If CheckEnabledProductExists(LReplacedByProductCodeHyphenated) Then
Result = Result + ", replaced by <a href=""" + GetProductLink(LReplacedByProductCodeHyphenated) + """>" + LReplacedByProductCode + "</a>"
End If
End If
End If
Else
Result = "Out of stock"
' (SS,1/2/16) added following
'Result = Result & ", " & GetPleaseContactForAvailabilityInfo
' (SS,25/7/17) replaced above with following to be notified rather than contact us
' (SS,25/8/17) replaced GetProductCode with GetActiveProductCode, to fix issue where it was returning the main product code in product page, instead of the related product code for the related section
' (SS,2/10/20) added rel=""nofollow"" to prevent search engine bots from indexing this
Result = Result & ", <a href=""" & GetStockNotificationLink(LProductCode) & """ rel=""nofollow"">notify me when back in stock</a>"
End If
End If
'Result = Result & "</br> "
' (SS,1/8/11) changed from above to following
Result = Result & BR
If LDaysDue < -15 Then
Result = Result & iif(AStockAvailabilityInfo = "", "", AStockAvailabilityInfo)
ElseIf LDaysDue > 0 Then
Result = Result & "Expected on " & ADateStockDue
Else ' i.e. >= -15 and < 0
Result = Result & "Expected soon"
End If
CustomGetStockInfo = Result
End Function
' (SS,18/1/13) show list of best sellers, recent reviews and new products on the left menu in a shuffled order
Sub CustomShuffledLeftMenuItems
Dim AOrder, i
ReDim AOrder(2)
AOrder(0) = 1
AOrder(1) = 2
AOrder(2) = 3
AOrder = ShuffleArray(AOrder) ' randomly shuffles
For i = 0 To 2
Select Case AOrder(i)
Case 1
ShowBestSellers
Case 2
ShowRecentReviews
Case 3
ShowNewProducts
End Select
Next
End Sub
' (SS,20/12/13) shown on create/edit account and checkout forms
Function CustomVATNumberHelpMessage
CustomVATNumberHelpMessage = "optional, for EU companies only"
End Function
' (SS,28/10/14) "P" for product page, "H" for home, AProductID is applicable
' call added to inc-template-product-details.asp and inc-template-home.asp
' also three tokens: Holiday Notice Radiators, Holiday Notice Other, Holiday Notice Home
' (SS,25/11/15) added "B" for "Holiday Notice Basket"
' (SS,14/10/16) added "C" for contact page
' (SS,24/5/17) adapted for HF
Sub CustomShowHolidayNotice(AType, AProductID)
Dim LToken
If AType = "B" Then
LToken = "Holiday Notice Basket"
ElseIf AType = "C" Then ' (SS,14/10/16)
LToken = "Holiday Notice Contact"
Else
LToken = "Holiday Notice Home"
End If
If LToken <> "" Then
Dim LNotice, LStartDate, LEndDate, LPos
LNotice = ComposeDescription("{" & LToken & "}", False, False)
' get date range from first line
If Left(LNotice, 6) = "[DATE:" Then
LStartDate = Mid(LNotice, 7, 10)
LEndDate = Mid(LNotice, 18, 10)
' if not valid start date then default to a very early date
If IsDate(LStartDate) Then
LStartDate = CDate(LStartDate)
Else
LStartDate = CDate("01/01/2000")
End If
' if not valid end date then default to a very late date
If IsDate(LEndDate) Then
LEndDate = CDate(LEndDate)
Else
LEndDate = CDate("01/01/2200")
End If
' remove the date bit
LPos = InStr(LNotice, "]")
If LPos > 0 Then LNotice = Mid(LNotice, LPos + 1)
If LStartDate > Date() Or LEndDate < Date() Then LNotice = ""
End If
Response.Write LNotice
End If
End Sub
' (SS,9/6/17) custom function for product option, only for radio
Function CustomGetProductOptionValueHTML(LOptionValueHTML, LOptionValueID, LOptionValueCount, LOptionValue, LOptionValueWithPrice, AOptionName, AInputType, LPicture)
Dim Result
If AInputType = "radio" Then
' show thumbnail after label
If LPicture Then
LOptionValueHTML = LOptionValueHTML & "<div class=""option-radio-image-div""><img class=""option-radio-image"" src=""" & GetProductOptionValueImageLink(LOptionValueID, "s") & """></div>"
End If
LOptionValueHTML = ""
Else ' return default
Result = LOptionValueHTML
End If
CustomGetProductOptionValueHTML = Result
End Function
' (SS,20/7/17)
' shows the bank transfer modal, called from apputils.asp
' (SS,29/9/17) added billing country parameter
' (SS,20/4/18) change to Bank Transfer payment button
' (SS,11/6/20) changed "Deutsche Handelsbank" to "TransferWise"
' (SS,20/6/22) changed width of button
' (SS,23/6/22) change to optional show preferred text
Function CustomShowBankTransferModal(ABillingCountry)
' If Not SaveBasketEnabled Then Exit Sub
Dim LOrderNo, LGrandTotal
LOrderNo = GetOrderNo
LGrandTotal = GetGrandTotalForOrder(LOrderNo)
' currency chosen on website and rate
Dim LWebsiteCurrencyCode, LWebsiteCurrencyRate, LDefaultPaymentCurrencyCode
LWebsiteCurrencyCode = GetOrderFieldValue(LOrderNo, "CurrencyCode")
LWebsiteCurrencyRate = GetOrderFieldValue(LOrderNo, "ExchangeRate")
LDefaultPaymentCurrencyCode = GetOrderFieldValue(LOrderNo, "DefaultPaymentCurrencyCode") ' (SS,12/9/17)
Dim LCurrencySymbol ' not used, only for return parameter from GetCurrencyExchangeRateAdjusted
Dim LEURCurrencyRate, LUSDCurrencyRate
GetCurrencyExchangeRateAdjusted "EUR", LEURCurrencyRate, LCurrencySymbol
GetCurrencyExchangeRateAdjusted "USD", LUSDCurrencyRate, LCurrencySymbol
' calculate amounts in each currency
Dim LGBPAmount, LWebAmount, LEURAmount, LUSDAmount
LGBPAmount = GetCurrencyFormattedValue(DEFAULT_CURRENCY_CODE, 1, LGrandTotal)
LWebAmount = GetCurrencyFormattedValue(LWebsiteCurrencyCode, LWebsiteCurrencyRate, LGrandTotal)
LEURAmount = GetCurrencyFormattedValue("EUR", LEURCurrencyRate, LGrandTotal)
LUSDAmount = GetCurrencyFormattedValue("USD", LUSDCurrencyRate, LGrandTotal)
' default bank order list
Dim LBankOrder
LBankOrder = "GBP,EUR,USD"
' (SS,29/9/17)
Dim LBillingCountryIsUK, LBillingCountryIsUS, LBillingCountryIsEU
LBillingCountryIsUK = IsUK(ABillingCountry)' i.e. United Kingdom
LBillingCountryIsUS = ABillingCountry = "United States"
LBillingCountryIsEU = GetPostalArea(ABillingCountry) = "EU"
' (SS,29/7/17) added If ABillingCountry = DEFAULT_CURRENCY_COUNTRY to now show GBP only, and LBillingCountryIsUS to show USD only
If LBillingCountryIsUK Then
LBankOrder = "GBP"
ElseIf LBillingCountryIsUS Then ' (SS,29/7/17)
LBankOrder = "USD"
'ElseIf LWebsiteCurrencyCode = "GBP" Or LWebsiteCurrencyCode = "EUR" Or LWebsiteCurrencyCode = "USD" Then
' If LWebsiteCurrencyCode = "EUR" Then
' LBankOrder = "EUR,GBP,USD"
' ElseIf LWebsiteCurrencyCode = "USD" Then
' LBankOrder = "USD,GBP,EUR"
' End If
'Else ' (SS,12/9/17) added following to encourage Borderless payments which we're hoping will be at look rates than HSBC
' If LDefaultPaymentCurrencyCode = "USD" Then
' LBankOrder = "USD,EUR,GBP"
' Else ' i.e. EUR
' LBankOrder = "EUR,USD,GBP"
' End If
' (SS,29/7/19) simplified above with following, i.e. EUR for Euro TransferWise which is International, and GBP for HSBC
ElseIf LBillingCountryIsEU Then ' for EU only show Euros
LBankOrder = "EUR"
Else
LBankOrder = "EUR,GBP"
End If
' (SS,20/4/18) modified bank transfer button to match the other payment buttons, i.e. change from btn-success to btn-primary and add btn-lg, and add says style settings, removed style="margin-top: 20px" from outer div, also removed image images/make-payment-bacs.png, added Preferred
' In the footer change button colour from btn-info to btn-success, i.e. light blue to green
' (SS,21/1/21) added bank transfer image
' (SS,20/6/22) reduced button min-width from 250px to 243px (due to same change to other payment buttons)
' (SS,23/6/22) replaced <br><small>Preferred :-)</small> with with LPaymentPreferred
' (SS,23/6/22) to highlight preferred if enabled
Dim LPaymentPreferred
If GetPaymentHighlightPreferred Then
LPaymentPreferred = "<br><small>Preferred :-)</small>"
Else
LPaymentPreferred = ""
End If
' (SS,23/6/26) modified following for Bootstrap 5
%>
<div>
<a href="#modal-content-bank-transfer" role="button" class="btn btn-success btn-lg" style="min-width:243px; margin-top:10px; margin-bottom:10px" data-bs-toggle="modal" data-bs-target="#modal-content-bank-transfer" title="Click this button to see bank transfer options">Pay by Bank Transfer<%=LPaymentPreferred%></a>
<a href="#modal-content-bank-transfer" data-bs-toggle="modal" data-bs-target="#modal-content-bank-transfer"><img src="images/make-payment-bank-transfer.png" style="max-height:55px; margin-left:10px; vertical-align:middle" alt="Pay by Bank Transfer"></a>
</div>
<div id="modal-content-bank-transfer" class="modal fade" tabindex="-1" aria-labelledby="bankTransferModalLabel" aria-hidden="true">
<div class="modal-dialog modal-dialog-centered">
<div class="modal-content">
<div class="modal-header">
<h5 id="bankTransferModalLabel" class="modal-title">Pay by Bank Transfer</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div>
<div class="modal-body">
<%
' show in correct order
Dim LBank, LBanks
LBanks = Split(LBankOrder, ",")
For Each LBank In LBanks
If LBank = "EUR" Then
' (SS,11/6/20) changed "Deutsche Handelsbank" to "TransferWise"
'CustomShowBankTransferBank LEURAmount, "EU", "our TransferWise account in the EU", "Euros"
' (SS,23/6/26) replaced above with following for improved wordwrap, also removed Euros with EUR (keeps the buttons the same size)
CustomShowBankTransferBank LEURAmount, "EU", "our TransferWise account in the EU", "EUR"
ElseIf LBank = "USD" Then
'CustomShowBankTransferBank LUSDAmount, "USA", "our CFSB account in the USA", "USD"
' (SS,23/6/26) replaced above with following for improved wordwrap
CustomShowBankTransferBank LUSDAmount, "USA", "our CFSB account in the USA", "USD"
ElseIf LBillingCountryIsUK Then ' i.e. GBP, TransferWise
'CustomShowBankTransferBank LGBPAmount, "UK", "our bank account in the UK", "GBP"
' (SS,23/6/26) replaced above with following for improved wordwrap
CustomShowBankTransferBank LGBPAmount, "UK", "our bank account in the UK", "GBP"
Else ' i.e. GBP, HSBC
'CustomShowBankTransferBank LGBPAmount, "UK", "our HSBC account based in the UK", "GBP"
' (SS,23/6/26) replaced above with following for improved wordwrap
CustomShowBankTransferBank LGBPAmount, "UK", "our HSBC account based in the UK", "GBP"
End If
Next
%>
</div>
<div class="modal-footer justify-content-start">
<button type="button" class="btn btn-outline-secondary" data-bs-dismiss="modal">Go back to other payment options</button>
</div>
</div><!-- /.modal-content -->
</div><!-- /.modal-dialog -->
</div><!-- /.modal -->
<%
CustomShowBankTransferModal = True ' always returns True, i.e. has to return something
End Function
' (SS,24/7/17) called from CustomShowBankTransferModal for each bank
' AAmount amount contains correctly formatted value and may contain two amounts separated by " or "
' ABankOptionCode can be UK, EU or USA
' bank-transfer-button-width fixes the button width for all 3
' (SS,20/4/18) changed button from btn-success to btn-primary (same as other payment buttons), made larger by adding btn-lg
' (SS,11/6/20) added new account changed alert message for EU
' (SS,1/3/22) removed the bank account changed message
' (SS,23/6/26) improvements for for Bootstrap 5
Sub CustomShowBankTransferBank(AAmount, ABankOptionCode, ABankAccountName, APayButtonCaption)
%>
<div class="bank-transfer-option">
<div class="bank-transfer-option-text">
Pay <strong><%=AAmount%></strong> into <%=ABankAccountName%>
</div>
<button type="button" class="btn btn-success btn-lg bank-transfer-button-width" onClick="<%=GetPaymentBankTranferOptionSubmitLink(ABankOptionCode)%>">Pay <%=APayButtonCaption%></button>
</div>
<%
' (SS,11/6/20)
' (SS,1/3/22) removed following by changing "EU" to "EU removed"
If ABankOptionCode = "EU removed" Then
%>
<div class="alert alert-danger" role="alert">Please note the bank account has changed. Please update your records and do not pay into the old account.</div>
<%
End If
End Sub
' (SS,28/8/25) to shipping column override or exclusion, AIncludeShipping defaults to True, set to True to excluding shipping column from feed, returns delivery cost to override with, this includes VAT
' (SS,2/9/25) added AAvailability, also added courier, service, package size and name to HTML output
' (SS,10/9/25) improvements
Function CustomGoogleShoppingDeliveryOverride(AType, ByRef AIncludeShipping, AIncludeProduct, AProductID, AProductCode, AProductName, AAvailability, AProductPrice, AVATContent, AWeight)
Dim LDeliveryCost, LCountry, LRegionCode, LIsHTML
LDeliveryCost = 6.50
If AType = "S" Then ' start
' (SS,1/9/25) added type querystring parameter to allow type=table i.e. special mode that renders a table for checking purpose instead of a text/plain suitable for Google Shopping
' allows rendering the table directly in browser for testing, rather than emailing
csGoogleShoppingContentTypeIsTable = CleanRequestQueryString("type") = "table"
csGoogleShoppingContentTypeIsText = Not csGoogleShoppingContentTypeIsTable
csGoogleShoppingFeedEmailBody = ""
csGoogleShoppingFeedCount = 0
' (SS,8/9/25) determine region code from delivery country
' DoGoogleShoppingDataFeed and GoogleShoppingSelectCountryAndCurrency in apputils determine the country and currency from the querystring i.e. country= and currency=
csGoogleShoppingRegionCode = "UK"
LCountry = GetDeliveryCountry
If LCountry <> "" Then
LRegionCode = GetRegionCode(LCountry)
If LRegionCode = "" Then LRegionCode = GetPostalArea(LCountry)
csGoogleShoppingRegionCode = LRegionCode
End If
CustomGoogleShoppingHTMLAdd "<html>" & NL
CustomGoogleShoppingHTMLAdd "<head>" & NL
CustomGoogleShoppingHTMLAdd "<meta charset=""UTF-8"">"
' add .js and .css files when in html mode (i.e. when email not sent)
If Not csGoogleShoppingContentTypeIsText Then
CustomGoogleShoppingHTMLAdd "<script src=""/common/jquery/jquery-3.7.1.min.js""></script>"
CustomGoogleShoppingHTMLAdd "<link rel=""stylesheet"" href=""datatables/datatables.min.css"">"
CustomGoogleShoppingHTMLAdd "<script src=""datatables/datatables.min.js""></script>"
CustomGoogleShoppingHTMLAdd "<script>$(document).ready( function () {$('#myTable').DataTable( {""lengthMenu"": [20, 50, 100, 200, 500, 1000, 2000], ""pageLength"": 2000 });} );</script>"
End If
CustomGoogleShoppingHTMLAdd "<style>" & NL
' CustomGoogleShoppingHTMLAdd "table, th, td {border: 1px solid black;border-collapse: collapse;}"
CustomGoogleShoppingHTMLAdd "th, td {padding: 5px;}"
CustomGoogleShoppingHTMLAdd "table td:nth-child(1) {text-align: right;}"
' CustomGoogleShoppingHTMLAdd "table td:nth-child(2) {white-space: nowrap;}"
CustomGoogleShoppingHTMLAdd "table td:nth-child(4) {text-align: center;}"
CustomGoogleShoppingHTMLAdd "table td:nth-child(5) {text-align: right;}"
CustomGoogleShoppingHTMLAdd "table td:nth-child(6) {text-align: right;}"
CustomGoogleShoppingHTMLAdd "table td:nth-child(7) {text-align: right;}"
CustomGoogleShoppingHTMLAdd "table.dataTable { font-family: Verdana, Geneva, Tahoma, sans-serif; font-size: 12px; }"
CustomGoogleShoppingHTMLAdd "table.dataTable>tbody>tr>th, table.dataTable>tbody>tr>td { padding: 4px 5px; }"
CustomGoogleShoppingHTMLAdd "</style>" & NL
CustomGoogleShoppingHTMLAdd "</head>"
CustomGoogleShoppingHTMLAdd "<body>" & NL
CustomGoogleShoppingHTMLAdd "<b>Country:</b> " & GetDeliveryCountry & " " & NL
CustomGoogleShoppingHTMLAdd "<b>Region Code:</b> " & csGoogleShoppingRegionCode & " " & NL
CustomGoogleShoppingHTMLAdd "<b>Currency:</b> " & GetCurrencyCode & " " & NL
CustomGoogleShoppingHTMLAdd "<b>Exchange Rate:</b> " & GetCurrencyRate & BR & NL
CustomGoogleShoppingHTMLAdd "<table id=""myTable"" class=""table cell-border stripe"">" & NL
CustomGoogleShoppingHTMLAdd "<thead>" & NL
CustomGoogleShoppingHTMLAdd "<tr>" & NL
CustomGoogleShoppingHTMLAdd "<th>#</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Product Code</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Product Name</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Stk</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Price</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Wgt</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Del.</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Courier</th>" & NL
' CustomGoogleShoppingHTMLAdd "<th>Service</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Pkg Size</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>Pkg Name</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>B L</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>B H</th>" & NL
CustomGoogleShoppingHTMLAdd "<th>T L</th>" & NL
CustomGoogleShoppingHTMLAdd "</tr>" & NL
CustomGoogleShoppingHTMLAdd "</thead>" & NL
CustomGoogleShoppingHTMLAdd "<tbody>" & NL
ElseIf AType = "E" Then ' end
CustomGoogleShoppingHTMLAdd "<tbody>" & NL
CustomGoogleShoppingHTMLAdd "</table>" & NL
CustomGoogleShoppingHTMLAdd "</body></html>" & NL
CustomGoogleShoppingHTMLAdd BR & GetTimer & BR
' (SS,2/9/25) only email if content type is text (not HTML)
If csGoogleShoppingContentTypeIsText Then
' (SS,12/9/25) only include the full table in the body if country is United Kingdom or United States or France
LCountry = GetDeliveryCountry
If LCountry = "United Kingdom" Or LCountry = "United States" And LCountry = "France" Then
LIsHTML = True
Else
csGoogleShoppingFeedEmailBody = "To minimise size of emails, table only for US, GB & FR"
LIsHTML = False
End If
SendEmail "google-shopping-feed@hyperflight.co.uk", "", "", "google-shopping-feed@hyperflight.co.uk", GetStoreName & " Google Shopping Feed Result (" & LCountry & ") (" & GetCurrencyCode & ")", csGoogleShoppingFeedEmailBody, LIsHTML
End If
Else ' i.e. "P" for product
' uncomment following line to exclude shipping from feed
' AIncludeShipping = False
' AIncludeProduct = False
Set oDeliveryCharge = New cDeliveryCharge
oDeliveryCharge.IsDataFeedMode = True
oDeliveryCharge.DataFeedProductID = AProductID
oDeliveryCharge.TotalValue = AProductPrice
oDeliveryCharge.VATContent = AVATContent
oDeliveryCharge.TotalWeight = AWeight
oDeliveryCharge.RegionCode = csGoogleShoppingRegionCode ' "UK"
oDeliveryCharge.Country = GetDeliveryCountry ' "United Kingdom"
oDeliveryCharge.Calculate
LDeliveryCost = oDeliveryCharge.DeliveryCharge
LDeliveryCost = Round2dp(LDeliveryCost + GetVATAmountToAddNC(LDeliveryCost))
If Not oDeliveryCharge.Error Then ' i.e. exclude LiPo products for certain countries
csGoogleShoppingFeedCount = csGoogleShoppingFeedCount + 1
CustomGoogleShoppingHTMLAdd "<tr>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & csGoogleShoppingFeedCount & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & "<a href=""" & GetProductLink(AProductCode) & """ target=""_blank"">" & AProductCode & "</a>" & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & HTMLEncode(AProductName) & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & IIf(AAvailability = "in stock", "", "No") & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & CorrectCurrencyNV(AProductPrice) & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & AWeight & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & CorrectCurrencyNV(LDeliveryCost) & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & oDeliveryCharge.Courier & "</td>" & NL
' CustomGoogleShoppingHTMLAdd "<td>" & oDeliveryCharge.Service & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & oDeliveryCharge.PackageSize & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & oDeliveryCharge.PackageName & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & IIf(oDeliveryCharge.BoxLength = 0, "", oDeliveryCharge.BoxLength) & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & IIf(oDeliveryCharge.BoxHeight = 0, "", oDeliveryCharge.BoxHeight) & "</td>" & NL
CustomGoogleShoppingHTMLAdd "<td>" & IIf(oDeliveryCharge.TubeLength = -1, "", oDeliveryCharge.TubeLength) & "</td>" & NL
CustomGoogleShoppingHTMLAdd "</tr>" & NL
Else
AIncludeProduct = False ' exclude due to delivery error, e.g. LiPo in disallowed countries
End If
Set oDeliveryCharge = Nothing
End If
CustomGoogleShoppingDeliveryOverride = LDeliveryCost
End Function
' (SS,31/8/25)
Function CustomGoogleShoppingHTMLAdd(AHTML)
If csGoogleShoppingContentTypeIsText Then
csGoogleShoppingFeedEmailBody = csGoogleShoppingFeedEmailBody + AHTML
Else ' if not text then render directly in browser
Response.Write AHTML & NL
End If
End Function
' (SS,29/7/26)
' Optional site-specific product delivery restriction check
' B = basket
' D = product details
' L = product list or related product
' I = basket item
Function CustomProductDeliveryAllowed(AProductCode, ACategory, ASubcategory, ADeliveryCountry, AMessageType, ByRef AMessage)
Dim LSubcategory
LSubcategory = LCase(Trim(ASubcategory))
CustomProductDeliveryAllowed = True
AMessage = ""
Select Case LSubcategory
Case "glues"
' Glues may be delivered worldwide except to the United States
If ADeliveryCountry = "United States" Then
CustomProductDeliveryAllowed = False
If AMessageType = "L" Or AMessageType = "I" Then
AMessage = "Cannot deliver to the US"
Else
AMessage = "Sorry, we can't deliver glues to the United States."
End If
End If
Case "lipo batteries"
' LiPo batteries may only be delivered within the United Kingdom
If ADeliveryCountry <> "United Kingdom" Then
CustomProductDeliveryAllowed = False
If AMessageType = "L" Or AMessageType = "I" Then
AMessage = "UK delivery only"
Else
AMessage = "Sorry, we can only deliver LiPo batteries within the United Kingdom."
End If
End If
End Select
If AMessage <> "" And AMessageType = "B" Then
AMessage = AMessage + " Please remove them from your basket."
End If
' Temporary debugging
'Response.Write _
' "<div class=""alert alert-warning small mb-2"">" & _
' "<strong>CustomProductDeliveryAllowed</strong><br>" & _
' "Product code: " & CustomDebugValue(AProductCode) & "<br>" & _
' "Category: " & CustomDebugValue(ACategory) & "<br>" & _
' "Subcategory: " & CustomDebugValue(ASubcategory) & "<br>" & _
' "Delivery country: " & CustomDebugValue(ADeliveryCountry) & "<br>" & _
' "Allowed: " & CustomDebugValue(CustomProductDeliveryAllowed) & "<br>" & _
' "Message: " & CustomDebugValue(AMessage) & _
' "</div>"
End Function
' Safely formats values used by the temporary debugging output
Function CustomDebugValue(AValue)
If IsNull(AValue) Then
CustomDebugValue = "<em>NULL</em>"
ElseIf IsEmpty(AValue) Then
CustomDebugValue = "<em>Empty</em>"
ElseIf CStr(AValue) = "" Then
CustomDebugValue = "<em>Blank</em>"
Else
CustomDebugValue = Server.HTMLEncode(CStr(AValue))
End If
End Function
%>