File: D:/web/circ.itp/delivery-cost-test.asp
<%Option Explicit%>
<!--#include file="dbfunctions.asp"-->
<!--#include file="apputils.asp"-->
<%DisableCache%>
<%
' (SS,06/03/23) to cost delivery cost entering the postcode and country etc
' (SS,08/03/23) added replaced all Request with CleanRequest to sanitize against HTML script tags, need to keep in this habit
%>
<html>
<head>
<title>Delivery Cost Test</title>
<link href="css/all.min.css" rel="stylesheet" />
<script src="https://code.jquery.com/jquery.min.js"></script>
<style>
.table_cen th, .table_cen td {
text-align: center;
}
</style>
</head>
<body>
<div class="container">
<div>
<h1>Delivery Cost Test</h1>
</div>
<div class="row">
<form method="post" class="">
<%
If Session("DeliveryCountry") = "" Then Session("DeliveryCountry") = "United Kingdom"
'Dim LRegionCode
'LRegionCode = GetRegionCode_
Dim LDeliveryCountry, LDeliveryPostcode, LRadiators, LOversize, LRegionCodeOld, LRegionCodeNew
LDeliveryCountry = CleanRequest("DeliveryCountry")
Session("DeliveryCountry") = LDeliveryCountry
LDeliveryPostcode = UCase(CleanRequest("DeliveryPostcode"))
Session("DeliveryPostcode") = LDeliveryPostcode
LRegionCodeOld = GetRegionCode_(LDeliveryCountry, "Pallet")
LRegionCodeNew = GetRegionCode_(LDeliveryCountry, "Pallet 2")
Dim LDeliveryCostOld1, LDeliveryCostOld4, LDeliveryCostOld8, LDeliveryCostOld1o, LDeliveryCostOld4o, LDeliveryCostOld8o
Dim LDeliveryCostNew1, LDeliveryCostNew4, LDeliveryCostNew8, LDeliveryCostNew1o, LDeliveryCostNew4o, LDeliveryCostNew8o
LDeliveryCostOld1 = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 1, False, "Pallet")
LDeliveryCostOld4 = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 4, False, "Pallet")
LDeliveryCostOld8 = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 8, False, "Pallet")
LDeliveryCostOld1o = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 1, True, "Pallet")
LDeliveryCostOld4o = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 4, True, "Pallet")
LDeliveryCostOld8o = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 8, True, "Pallet")
LDeliveryCostNew1 = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 1, False, "Pallet 2")
LDeliveryCostNew4 = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 4, False, "Pallet 2")
LDeliveryCostNew8 = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 8, False, "Pallet 2")
LDeliveryCostNew1o = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 1, True, "Pallet 2")
LDeliveryCostNew4o = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 4, True, "Pallet 2")
LDeliveryCostNew8o = CustomGetDelivery(LDeliveryPostcode, LDeliveryCountry, 8, True, "Pallet 2")
%>
<div class="form-group col-xs-3">
<label for="DeliveryCountry">Delivery Country</label>
<%=GetCountryCombo("DeliveryCountry", "")%>
</div>
<div class="form-group col-xs-3">
<label for="DeliveryPostcode">Delivery Postcode</label>
<input type="text" name="DeliveryPostcode" id="DeliveryPostcode" class="form-control text-uppercase" placeholder="" value="<%=Session("DeliveryPostcode")%>" maxlength="12">
</div>
<div class="form-group col-xs-12">
<button type="submit" class="btn btn-primary mb-2" name="Calculate" value="Yes">Calculate</button>
</div>
</form>
</div>
<%
If CleanRequest("Calculate") = "Yes" Then
%>
<h2> Delivery Calculation </h2>
<div class="row">
<div class="col-xs-6">
<table class="table table-bordered">
<tr>
<th style="width:0%">Delivery Country</th><td><%=LDeliveryCountry%></td>
</tr>
<tr>
<th>Delivery Postcode</th><td><%=LDeliveryPostcode%></td>
</tr>
<tr>
<th>Region Code Old</th><td><%=LRegionCodeOld%></td>
</tr>
<tr>
<th>Region Code New</th><td><%=LRegionCodeNew%></td>
</tr>
</table>
</div>
<div class="col-xs-6">
<table class="table table-bordered table_cen">
<tr>
<th style="vertical-align:middle">Radiators</th><th style="vertical-align:middle">Oversize</th><th>Old Delivery Cost</th><th>New Delivery Cost</th>
</tr>
<tr>
<td>1</td><td>No</td><td><%=LDeliveryCostOld1%></td><td><%=LDeliveryCostNew1%></td>
</tr>
<tr>
<td>4</td><td>No</td><td><%=LDeliveryCostOld4%></td><td><%=LDeliveryCostNew4%></td>
</tr>
<tr>
<td>8</td><td>No</td><td><%=LDeliveryCostOld8%></td><td><%=LDeliveryCostNew8%></td>
</tr>
<tr>
<td>1</td><td>Yes</td><td><%=LDeliveryCostOld1o%></td><td><%=LDeliveryCostNew1o%></td>
</tr>
<tr>
<td>4</td><td>Yes</td><td><%=LDeliveryCostOld4o%></td><td><%=LDeliveryCostNew4o%></td>
</tr>
<tr>
<td>8</td><td>Yes</td><td><%=LDeliveryCostOld8o%></td><td><%=LDeliveryCostNew8o%></td>
</tr>
</table>
</div>
</div>
<%
End If
%>
</body>
</html>
<%
Function GetRegionCode_(ACountry, APostcodeGroup)
Dim LRegionCode, LCountry
LCountry = ACountry
' (SS,5/6/07) modified to get new region code field, GetPostalArea is used if GetRegionCode returns blank
LRegionCode = GetRegionCode(LCountry)
If LRegionCode = "" Then LRegionCode = GetPostalArea(LCountry)
' (SS,16/1/15) moved following here from below, renamed from LPostcode to LDeliveryPostcode
Dim LDeliveryPostcode
LDeliveryPostcode = Session("DeliveryPostcode")
If LDeliveryPostcode = "" Then LDeliveryPostcode = Session("Postcode")
' Response.Write "###" & LDeliveryPostcode & "###" & BR
' (SS,16/1/15) if UseDeliveryPostcodes enabled in UK then we determine region from postcode
If UseDeliveryPostcodes And IsUK(LCountry) Then
LRegionCode = GetDeliveryRegionFromPostcode(LDeliveryPostcode, APostcodeGroup)
If LRegionCode = "" Then
FDeliveryCalculationFailure = True
SetAlertMessage "Your postcode might be wrong. Please check."
End If
End If
GetRegionCode_ = LRegionCode
End Function
' (SS,6/11/20) change to allow radiatory delivery cost to override the normal delivery cost
' (SS,22/12/20) added separate pallet delivery charge for Republic of Ireland
' (SS,16/6/21) added setting of priority to 7 if clearance radiators and no bespoke radiators
' (SS,17/9/21) added setting of DeliveryOption to show "Kerbside Pallet Delivery" for radiators, also required a change to inc-template-basket.asp
' (SS,1/3/22) applied pallet delivery price increases
' (SS,28/9/22) change to not allow delivery for Republic of Ireland, i.e. they contact for delivery cost
' Function CustomGetDelivery(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
Function CustomGetDelivery(APostcode, ACountry, LRadiators, ACustomOversizeRadiator, APostcodeGroup)
Dim LDelivery, LMinPrice, LFactor, LFixedPrice
' calculate delivery price for radiators, by counting number of radiators ordered (product names containing the word "radiator")
' Dim LRadiators, LRadiatorDeliveryCost
Dim LRadiatorDeliveryCost
' LRadiators = GetFlaggedItemsInBasket(True) ' was GetProductNameTokensInBasket("radiator")
' LRadiatorDeliveryCost = 0
If LRadiators > 0 Then
' following table used
' No of Mainland England, Wales and Scottish postcodes Scottish postcodes Northern Ireland
' Radiators DG, EH, FK, G, KA, KY, ML, PA 1-19, TD AB, DD, IV, KW, ND, PA 20+, PH & Dublin
' 1-3 45 58 68
' 4-7 47.50 68 75
' 8+ 50 78 85
' Other areas, i.e. For Isle of Man,Isle of White PO 30 – 41,Channel Islands,Rest of EIRE,Rest of EUROPE: Rates on Request
' (SS,7/11/08) changed to
' No of Mainland England, Northern Ireland Isle of Man, Isle of Wight PO30-41
' Radiators Wales and Scottish & Eire Channel Islands, Mainland Europe
' 1-3 45 68 105
' 4-7 50 75 130
' 8+ 65 85 169
' determine regions 1 to 4
' UK (England)
Dim LRegionIndex
' (SS,18/4/12) postcode split code moved here from ElseIf ACountry = "Isle of Wight", now used for "UK (Scotland)", also added UK (Offshore) which people might choose if isles off Scotland
' (SS,16/01/15) simplified, postcode now determines region from new delivery_postcodes table, not country, because UK country variations no longer used
' removed hardcoded postcode code
' (SS,11/2/15) postcode is now used to determine region code from delivery_postcodes table Group Name "Pallet"
' also replaced UK2 with R2 and EU with R3, added "Republic of Ireland" to "R3"
' (SS,22/12/20) adjustment for Republic of Ireland due to Brexit
'
Dim LDeliveryRegionCode, LCountryISOCode
LCountryISOCode = GetCountryISOCode(ACountry)
If LCountryISOCode = "GB" Then ' i.e. UK
' (SS,23/6/17) added following for Channel Islands, quick fix, proper fix via postcode to be implemented ***
' (SS,14/5/19) removed following to also check the delivery post code
'If ACountry = "Channel Islands" then
' LDeliveryRegionCode = "R3"
'Else ' (SS,23/6/17) as before
' LDeliveryRegionCode = GetDeliveryRegionFromPostcode(APostcode, "Pallet")
LDeliveryRegionCode = GetDeliveryRegionFromPostcode(APostcode, APostcodeGroup)
'End If
' (SS,28/9/22) commented out following two lines, "Republic of Ireland" now treated like RegionIndex 5 i.e. contact for delivery quote
'ElseIf LCountryISOCode = "IE" Then ' i.e. "Republic of Ireland"
' LDeliveryRegionCode = "R4" ' (SS,22/12/20) changed from "R3" to "R4"
Else
LDeliveryRegionCode = ""
End If
' (SS,11/2/15) replaced ARegionCode with LDeliveryRecordCode
If LDeliveryRegionCode = "UK" Then
LRegionIndex = 1
ElseIf LDeliveryRegionCode = "R2" Then
LRegionIndex = 2
ElseIf LDeliveryRegionCode = "R3" Then
LRegionIndex = 3
' (SS,22/12/20) added following for Republic of Ireland
ElseIf LDeliveryRegionCode = "R4" Then
LRegionIndex = 4
Else ' i.e. ""
LRegionIndex = 5 ' (SS,22/12/20) changed from 4 for 5 due to Republic of Ireland using 4
End If
' if LRegionIndex is 4 then notify that they need to phone for delivery cost
' (SS,22/12/20) changed from 4 to 5, 4 now used for Republic of Ireland
If LRegionIndex = 5 Then
' (SS,12/2/10) added order email
' SetAlertMessage("Please phone or email us for radiator delivery cost")
' (SS,18/4/12) replaced above with following
SetAlertMessage("Please contact us for delivery quote")
CustomGetDelivery = -1
Exit Function
End If
' I'm ignoring the 0 elements, easier this way
' (SS,22/12/20) modified from 3, 3 to 4, 3 to handle new region for Republic of Ireland
Dim LDeliveryArray(4, 3)
' (SS,1/3/22) applied £10 increase for pallet delivery all zones
LDeliveryArray(1, 1) = 55
LDeliveryArray(1, 2) = 60
LDeliveryArray(1, 3) = 75
LDeliveryArray(2, 1) = 78
LDeliveryArray(2, 2) = 85
LDeliveryArray(2, 3) = 95
LDeliveryArray(3, 1) = 115
LDeliveryArray(3, 2) = 140
LDeliveryArray(3, 3) = 179
' (SS,22/12/20) for Republic of Ireland
' Paul's email:
' This is not required to be effective until 4th January, but I have just been emailed with the additional charges for customs clearance for Rep of Ireland pallet deliveries!! Nothing like being prepared ?
' We may need to set up a new zone for Rep of Ireland pallet deliveries in order to adjust their prices moving forward, but initially, I need to increase the pallet prices to the following:
' 1-3 = £145.00 + vat
' 4-7 = £170.00 + vat
' 8+ = £209.00 + vat
' Oversize surcharge remains at £40.00 per pallet.
'
' Added following
LDeliveryArray(4, 1) = 155
LDeliveryArray(4, 2) = 180
LDeliveryArray(4, 3) = 219
' (SS,17/12/14) added following, 0 element (Radiator Index 0) now holds the oversize charge for each region
' (SS,1/3/22) applied £5 increase for oversize radiators (all 4)
LDeliveryArray(1, 0) = 25
LDeliveryArray(2, 0) = 25
LDeliveryArray(3, 0) = 45
LDeliveryArray(4, 0) = 45 ' (SS,22/12/20) for new region Republic of Ireland
Dim LRadiatorIndex
If LRadiators <= 3 Then
LRadiatorIndex = 1
ElseIf LRadiators <= 7 Then
LRadiatorIndex = 2
Else
LRadiatorIndex = 3
End If
LRadiatorDeliveryCost = LDeliveryArray(LRegionIndex, LRadiatorIndex)
' (SS,17/12/14) if oversize then add the oversize cost
' CovDem and CIRC have different attributes because Sections is an option in CIRC
' If Not CustomSiteIsCIRC Then FCustomOversizeRadiator = GetAttributeInBasketCount("Oversize Radiator", "") > 0
If ACustomOversizeRadiator Then LRadiatorDeliveryCost = LRadiatorDeliveryCost + LDeliveryArray(LRegionIndex, 0)
End If
' (SS,4/10/11) delivery calculation for doors
Dim LDoors, LDoorDeliveryCost
LDoors = GetAttributeInBasketCount("Product Type", "Door")
' (SS,3/2/12) amended LDoors from 4 to 6
' (SS,6/5/15) amended from 10 to 25 per door
' (SS,6/5/15) replaced previous code (If statement) with following, now 25 per month with max cap of £100
LDoorDeliveryCost = Min(LDoors * 25, 100)
' delivery price is the maximum of delivery cost of normal items and radiator delivery cost, and now also door delivery cost
' CustomGetDelivery = Iif(ANormalDeliveryCost > LRadiatorDeliveryCost, ANormalDeliveryCost, LRadiatorDeliveryCost)
' (SS,4/10/11) replaced above with following to take into account LDoorDeliveryCost as well
' (SS,6/11/20) Paul, CIRC, phoned regarding a possible anomaly, large order with oversize, should have been £85 for delivery, not £95
' was due to ANormalDeliveryCost being £95 due to large amount of non-radiator products. He said to use the radiator cost in such cases.
' added "If" to following to allow LRadiatorDeliveryCost to override the delivery cost
If LRadiatorDeliveryCost > 0 Then
CustomGetDelivery = LRadiatorDeliveryCost
Else ' (SS,6/11/20) as before (LRadiatorDeliveryCost has become redundant in following)
CustomGetDelivery = Max(Max(ANormalDeliveryCost, LRadiatorDeliveryCost), LDoorDeliveryCost)
End If
' ========== START OF SET PRIORITY ==========
' (SS,16/6/21) set priority to 7 if clearance radiator and no bespoke radiator in basket
' not in local mode or google shopping data feed
If Not IsLocalMode And Not InGoogleShoppingDataFeed Then
Dim LPriority, LRadiatorCount, LBespokeRadiatorCount
LRadiatorCount = GetAttributeInBasketCount("Product Type", "Radiator")
LBespokeRadiatorCount = GetAttributeWithOptionNameInBasketCount("Product Type", "Radiator", "Sections")
If LRadiatorCount > 0 And LBespokeRadiatorCount = 0 Then
LPriority = 7
Else
LPriority = 5
End If
SetPriority LPriority
End If
' ========== END OF SET PRIORITY ==========
' (SS,17/9/21) to show on basket, final checkout stage and confirmation email page "Kerbside Pallet" with kerbside in bold if order contains a radiator, else as before i.e. "Delivery"
If LRadiators > 0 Then
SetDeliveryOption "<b>Kerbside</b> Pallet"
Else
SetDeliveryOption ""
End If
End Function
%>