File: D:/web/hyperflight/! previous changes 2/2025-03-26/prev/customutils.asp
<!--#include file="CustomGetDeliveryOriginal.asp"-->
<!--#include file="CustomGetDeliveryRefactored.asp"-->
<!--#include file="CustomGetDeliveryNewAlgorithm.asp"-->
<!--#include file="CustomGetDeliveryNewAlgorithmV2.asp"-->
<!--#include file="CustomGetDeliveryNewAlgorithmV3.asp"-->
<%
' ==============
' customutils.asp
' ==============
' Version 1.50 (24/03/24)
' ============
' 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
' 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
Function CustomGetDelivery(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
Dim LDelivery
' if basket page and local PC then show all 3 delivery costs
' (SS,8/3/24) added And False to disable this for now
' (SS,26/6/24) removed And False to let Neil see the additional versions
' (SS,21/3/25) added Royal Mail columns
If IsBasketPage And CustomIsLocalPC Then
%>
<table><tr><td>Following table only shown on ITP local PC</td></tr></table>
<table class="table table-bordered table-condensed text-center">
<tr>
<th class="text-center" style="vertical-align:middle">Delivery Algorithm</th>
<th class="text-center" style="vertical-align:middle">Delivery Amount<br><small>(exc. VAT)</small></th>
<th class="text-center" style="vertical-align:middle">Delivery Amount<br><small>(inc. VAT)</small></th>
<th class="text-center" style="vertical-align:middle">Priority</th>
<th class="text-center" style="vertical-align:middle">LiPo</th>
<th class="text-center" style="vertical-align:middle">Postal Tube<br><small><small>(max mm)</small></small></th>
<th class="text-center" style="vertical-align:middle">Original Weight</th>
<th class="text-center" style="vertical-align:middle">Max<br>Packaged<br>Weight</th>
<th class="text-center" style="vertical-align:middle">Adjusted Weight</th>
<th class="text-center" style="vertical-align:middle">Tracked</th>
<th class="text-center" style="vertical-align:middle">Expedited</th>
<th class="text-center" style="vertical-align:middle">Normal Delivery</th>
<th class="text-center" style="vertical-align:middle">Extra Delivery</th>
<th class="text-center" style="vertical-align:middle">Delivery Uplift</th>
<th class="text-center" style="vertical-align:middle">Royal Mail</th>
<th class="text-center" style="vertical-align:middle">RM Zone</th>
<th class="text-center" style="vertical-align:middle">RM SC</th>
<th class="text-center" style="vertical-align:middle">RM Band</th>
</tr>
<%
' (SS,5/10/22) added LOriginalAW, LRefactoredAW, LNewAlgorithmAW and LNewAlgorithmV2AW
' (SS,21/3/25) added CustomShowClearRMDeliveryVars before each
CustomShowClearRMDeliveryVars
LDelivery = CustomGetDeliveryOriginal(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
CustomShowDeliveryTableRow "Original", LDelivery, ATotalWeight
CustomShowClearRMDeliveryVars
LDelivery = CustomGetDeliveryRefactored(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
CustomShowDeliveryTableRow "Refactored", LDelivery, ATotalWeight
CustomShowClearRMDeliveryVars
LDelivery = CustomGetDeliveryNewAlgorithm(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
CustomShowDeliveryTableRow "New", LDelivery, ATotalWeight
CustomShowClearRMDeliveryVars
LDelivery = CustomGetDeliveryNewAlgorithmV2(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
CustomShowDeliveryTableRow "New v2", LDelivery, ATotalWeight ' (SS,5/10/22)
' (SS,21/3/25)
CustomShowClearRMDeliveryVars
LDelivery = CustomGetDeliveryNewAlgorithmV3(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
CustomShowDeliveryTableRow "New v3", LDelivery, ATotalWeight
%>
</table>
<%
End If
' actual one used currently
LDelivery = CustomGetDeliveryOriginal(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"
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)
Function CustomGetRoyalMailDeliveryCost(ACountry, AIsTracked, AWeightGrams)
Dim LResult, LRMZone, LServiceCode, LPackageSize
LResult = -1
' get zone, if blank then assume WZ1
LRMZone = GetSQLValueAsString("SELECT RMZone FROM Countries WHERE Country = '" + CleanSQLStr(ACountry) + "'")
If LRMZone = "" Then LRMZone = "WZ1"
If IsUK(ACountry) Then
LServiceCode = "CRL24"
Else
If AIsTracked Then
LServiceCode = "OTA"
Else
LServiceCode = "OLA"
End If
End If
LPackageSize = "Parcel"
Dim LSQL, LDeliveryCost, LWeightBand
LSQL = "SELECT " + LRMZone + ", WeightUpToGrams FROM " + CustomGetRoyalMainDeliveryCostTableName + " WHERE ServiceCode = '" + LServiceCode + "' AND PackageSize = '" + LPackageSize + "' AND WeightUpToGrams >= " & AWeightGrams
If Not GetSQL2Values(LSQL, LDeliveryCost, LWeightBand) Then
LResult = -1
End If
If LDeliveryCost = "" Then
LResult = -1
Else
LResult = CDbl(LDeliveryCost)
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
%>
<div>
<a href="#modal-content-bank-transfer" role="button" class="btn btn-primary btn-lg" style="min-width:243px; margin-top:10px; margin-bottom:10px" data-toggle="modal" title="Click this button to see bank transfer options">Pay by Bank Transfer<%=LPaymentPreferred%></a>
<a href="#modal-content-bank-transfer" data-toggle="modal"><img src="images/make-payment-bank-transfer.png" style="max-height:55px; margin-left:10px; vertical-align:center" alt="Pay by Bank Transfer"></a>
</div>
<div id="modal-content-bank-transfer" class="modal fade">
<div class="modal-dialog">
<div class="modal-content">
<div class="modal-header">
<button type="button" class="close" data-dismiss="modal"><span aria-hidden="true">×</span><span class="sr-only">Close</span></button>
<h4 class="modal-title">Pay by Bank Transfer</h4>
</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"
ElseIf LBank = "USD" Then
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"
Else ' i.e. GBP, HSBC
CustomShowBankTransferBank LGBPAmount, "UK", "our HSBC account based in the UK", "GBP"
End If
Next
%>
</div>
<div class="modal-footer">
<button type="button" class="btn btn-success" data-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
Sub CustomShowBankTransferBank(AAmount, ABankOptionCode, ABankAccountName, APayButtonCaption)
%>
<p>
<button type="button" class="btn btn-primary btn-lg bank-transfer-button-width" data-dismiss="modal" onClick="<%=GetPaymentBankTranferOptionSubmitLink(ABankOptionCode)%>">Pay <%=APayButtonCaption%></button>
Pay <strong><%=AAmount%></strong> into <%=ABankAccountName%>
</p>
<%
' (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
%>