<%'@ LANGUAGE="VBScript" %>
<%
' =====================================================================================
' = File: incUPS.asp
' = Description:
' = UPS Quick Calculator Integration
' = v3.1 - mred - 06jan03 - updated for new UPS Implementation
' =====================================================================================
const STR_UPS_DEVELOPER_ID = "7337" ' Client
const STR_UPS_DEVELOPER_KEY = "2B9D66ACAEB1A262" ' Client
const STR_UPS_DEVELOPER_PWD = "lavender" ' Client
const STR_UPS_ACCESS_KEY = "5BA9827FD670A568" ' Client
const STR_UPS_ACTION = "3" ' action: 3=use selected
const STR_UPS_SHOWALL = "4" ' action: 4=show all options
const STR_UPS_residential = true ' residential: 1=yes
const STR_UPS_commercial = false ' residential: 0=no
' merchant constants
'const STR_MERCHANT_CITY = "Sacramento"
'const STR_MERCHANT_STATE = "CA"
'const STR_MERCHANT_ZIP = "95842"
'const STR_MERCHANT_COUNTRY = "US"
dim objUPS
dim strShipCode, strShipType
strShipCode = ""
strShipType = ""
' price matrix for UPS shipping:
' aryShipUPS_Matrix(n,0) = title : aryShipUPS_Matrix(n,1) = shipping cost
'--------- code for Shipment Type Matrix ---------
' result: array of UPS Shipment types & costs
function UPS_Trans_Matrix(intOrderID, intShipOption, aryShipUPS_Matrix, intShipWeight)
dim intOrderShipID, blnDebugcode, blnShowResults
intOrderShipID = GetOrderBillID_Other(intOrderID,true)
blnDebugcode = false
blnShowResults = false
' Get Order Info (shipping address)
dim strSQL, strLabel, strEmail, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry, strDayPhone, strNightPhone, strFax, intTaxZone
GetOrderAddress_Other intOrderID, true, intOrderShipID, strLabel, strEmail, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry, strDayPhone, strNightPhone, strFax, intTaxZone
if IsNumeric(intShipWeight) then
intShipWeight = Round(cDbl(intShipWeight),2)
if intShipWeight < 1 then
intShipWeight = 1
end if
else
intShipWeight = 1
end if
if blnDebugcode then ' and false debug code
Draw_UPS_DebugHeader intOrderID, intShipOption, intShipWeight, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry
end if
if IsValid(strZip) then
dim z
z = instr(strZip,"-") -1
if z > 0 then
strZip = trim(Left(strZip, z))
elseif len(strZip) > 5 then
strZip = Left(trim(strZip),5)
end if
else
aryShipUPS_Matrix(0,0) = "Select Option" : aryShipUPS_Matrix(0,1) = 0
response.write "Could not find zipcode for Ship To address." & "
" & vbcrlf
if blnDebugcode then ' and false debug code
Draw_UPS_DebugFooter
end if
UPS_Trans_Matrix = aryShipUPS_Matrix
exit function
end if
'----- intStep values 0=Commercial, 1=Residential -----
dim intStep, strProduct, fltPrice
intStep = 1
fltPrice = 0
strProduct = ""
aryShipUPS_Matrix = UPS_InitPage(intStep, STR_UPS_SHOWALL, intShipWeight, strZip, blnDebugcode)
' show UPS Price Matrix Array
if blnShowResults then 'debug code
dim xCnt, maxOption
maxOption = ubound(aryShipUPS_Matrix)
response.write "" & vbcrlf
response.write "-------------------------------RESULTS----------------------------
"
for xCnt = 0 to maxOption
response.write aryShipUPS_Matrix(xCnt,0) & " : " & aryShipUPS_Matrix(xCnt,1) & "
" & vbcrlf
next
response.write "
" & vbcrlf
Draw_UPS_DebugFooter
end if
UPS_Trans_Matrix = aryShipUPS_Matrix
end function
'------- price matrix for UPS shipping: -------
' aryShipUPS_Matrix(n,0) = title : aryShipUPS_Matrix(n,1) = shipping cost
'
' aryShipUPS_Matrix(0,0) = Commercial - UPS Ground : aryShipUPS_Matrix(0,1) = 4.23
' aryShipUPS_Matrix(1,0) = Commercial - UPS 3 Day Select : aryShipUPS_Matrix(1,1) = 7.80
' aryShipBaseMatrix(2,0) = Commercial - UPS 2nd Day : aryShipUPS_Matrix(2,1) = 10.63
' aryShipUPS_Matrix(3,0) = Commercial - UPS Overnight : aryShipUPS_Matrix(3,1) = 26.58
' aryShipUPS_Matrix(4,0) = Residencial - UPS Ground : aryShipUPS_Matrix(4,1) = 5.40
' aryShipUPS_Matrix(5,0) = Residencial - UPS 3 Day Select : aryShipUPS_Matrix(5,1) = 8.96
' aryShipUPS_Matrix(6,0) = Residencial - UPS 2nd Day : aryShipUPS_Matrix(6,1) = 11.80
' aryShipUPS_Matrix(7,0) = Residencial - UPS Overnight : aryShipUPS_Matrix(7,1) = 27.74
'-------------- UPS_InitPage ------------------
function UPS_InitPage(intStep, strAction, intShipWeight, strZip, blnDebugcode)
' redim aryShipUPS_Matrix(7,1) ' Commercial & Residential
redim aryShipUPS_Matrix(3,1) ' Residential only
dim blnDebug
blnDebug = false
if blnDebugcode or blnDebug then
response.write "SHOW ALL: " & strAction & " = " & STR_UPS_SHOWALL & " " & iif(strAction = STR_UPS_SHOWALL, "True","False") & "
" & vbcrlf
end if
dim xcnt, intItem, maxOption, strType, strShipType, fltShipRate, fltPrice
if strAction = STR_UPS_SHOWALL then
' maxOption = int((ubound(aryShipUPS_Matrix) / 2)) ' Commercial & residential
maxOption = ubound(aryShipUPS_Matrix) ' Residential only
else
maxOption = 1
end if
dim objShipment
dim objPackage
dim objUPSRate
set objUPS = new UPSManager
set objShipment = new shipment
set objPackage = new package
' objUPS.Init "username", "password", "XMLAcessKey"
objUPS.Init STR_UPS_DEVELOPER_ID, STR_UPS_DEVELOPER_PWD, STR_UPS_ACCESS_KEY
if blnDebugcode then
objUPS.SetDebug() '[OPTIONAL]
end if
objShipment.ShipperCity = STR_MERCHANT_CITY '"Sacramento" '[OPTIONAL]
objShipment.ShipperState = STR_MERCHANT_STATE '"CA" '[OPTIONAL]
objShipment.ShipperCountryCode = STR_MERCHANT_COUNTRY '"US" '[OPTIONAL]
objShipment.ShipperPostalCode = STR_MERCHANT_ZIP '95814
' objShipment.ShipToCity = strCity '"Rescue" '[OPTIONAL]
' objShipment.ShipToState = strState '"CA" '[OPTIONAL]
' objShipment.ShipToCountryCode = strCountry '"US" '[OPTIONAL]
objShipment.ShipToPostalCode = strZip '95672
objShipment.Residential = iif(intstep=1,STR_UPS_residential,STR_UPS_commercial) 'true '[OPTIONAL default=false]
objShipment.ServiceCode = 3 '[OPTIONAL default=3]
objShipment.PickupType = 1 '[OPTIONAL default=1]
objPackage.ContentWeight = intShipWeight
objPackage.PackagingWeight = 0.5 '[OPTIONAL default=0.5]
objPackage.Length = 11 '[OPTIONAL default=11]
objPackage.Width = 9 '[OPTIONAL default=9]
objPackage.Height = 4 '[OPTIONAL default=4]
objPackage.PackageType = 2 '[OPTIONAL default=2]
objShipment.AddPackage(objPackage)
' ---- add a second package ----
' set objPackage = new package
' objPackage.ContentWeight = 45
' objShipment.AddPackage(objPackage)
objUPS.AddShipment(objShipment)
' get shipping costs and/or populate UPS Price Matrix Array
'----- intStep values 0=Commercial, 1=Residential -----
dim i
'for intStep = 0 to 1
strType = iif(intStep=0,"Commercial","Residential")
' intItem = iif(intStep=0,0,maxOption+1) ' Commercial & Residential
intItem = 0 ' Residential only
xcnt = 0
objUPS.Process()
if blnDebugcode or blnDebug then
response.write objUPS.Shipment(0).UPSRateCount & "
"
end if
for each objUPSRate in objShipment.UPSRates
strShipType = objUPSRate.ServiceName
fltShipRate = objUPSRate.TotalCost
if blnDebug then
response.write strShipType & ": " & FormatCurrency(fltShipRate) & "
"
end if
if strAction = STR_UPS_showall then ' get rates for all Products
if intStep = 0 then ' Commercial Rates
if xcnt < 2 or xcnt = 3 or xcnt = 6 then
aryShipUPS_Matrix(intItem,0) = strType & " - " & strShipType : aryShipUPS_Matrix(intItem,1) = fltShipRate
intItem = intItem + 1
if fltPrice = 0 then
fltPrice = fltShipRate
end if
end if
else ' Residential Rates
if xcnt < 3 or xcnt = 5 then
aryShipUPS_Matrix(intItem,0) = strType & " - " & strShipType : aryShipUPS_Matrix(intItem,1) = fltShipRate
intItem = intItem + 1
if fltPrice = 0 then
fltPrice = fltShipRate
end if
end if
end if
elseif strShipType = strProduct then ' get rate for single Product
aryShipUPS_Matrix(intItem,0) = strType & " - " & strShipType : aryShipUPS_Matrix(intItem,1) = fltShipRate
intItem = intItem + 1
if fltPrice = 0 then
fltPrice = fltShipRate
end if
end if
xcnt = xcnt + 1
next
' ------- reinitialize objShipment.residential -------
' for i = 0 to objUPS.ShipmentCount -1
' objUPS.Shipment(i).Residential = true
' next
'next
UPS_InitPage = aryShipUPS_Matrix
end function
'-------------- Draw_UPS_DebugHeader ------------------
sub Draw_UPS_DebugHeader( intOrderID, intShipOption, intShipWeight, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry)
response.write "" & vbcrlf
response.write "intOrderID: " & intOrderID & " "
response.write "intShipOption: " & intShipOption & " "
response.write "intShipWeight: " & intShipWeight & "
" & vbcrlf
response.write "Ship To: " & strFirstName & " " & strLastName & "
" & vbcrlf
response.write "Address: " & strAddress1 & " " & strAddress2 & "
" & vbcrlf
response.write "City: " & strCity & " "
response.write "State: " & strState & " "
response.write "Zip Code: " & strZip & " "
response.write "Country: " & strCountry & "
" & vbcrlf
end sub
'-------------- Draw_UPS_DebugFooter ------------------
sub Draw_UPS_DebugFooter
response.write "
" & vbcrlf
end sub
'--------- code for single Shipment Type ---------
' result: cost of single UPS Shipment type
'-------------- UPS_Trans_Run ------------------
function UPS_Trans_Run(intOrderID, intShipOption, intShipWeight)
UPS_Trans_Run = 0
dim intOrderShipID, blnDebugcode
intOrderShipID = GetOrderBillID_Other(intOrderID,true)
blnDebugcode = false
' Get Order Info (shipping address)
dim strSQL, strLabel, strEmail, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry, strDayPhone, strNightPhone, strFax, intTaxZone
GetOrderAddress_Other intOrderID, true, intOrderShipID, strLabel, strEmail, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry, strDayPhone, strNightPhone, strFax, intTaxZone
if IsNumeric(intShipOption) then
intShipOption = CLng(intShipOption)
else
intShipOption = 2
end if
if IsNumeric(intShipWeight) then
intShipWeight = CLng(intShipWeight)
if intShipWeight < 1 then
intShipWeight = 1
end if
else
intShipWeight = 1
end if
if blnDebugcode then ' and false debug code
Draw_UPS_DebugHeader intOrderID, intShipOption, intShipWeight, strFirstName, strLastName, strCompany, strAddress1, strAddress2, strCity, strState, strZip, strCountry
end if
if IsValid(strZip) then
dim z
z = instr(strZip, "-")
if z > 0 then
strZip = trim(Left(strZip, z))
elseif len(strZip) > 5 then
strZip = Left(trim(strZip), 5)
end if
else
aryShipUPS_Matrix(0,0) = "Select Option" : aryShipUPS_Matrix(0,1) = 0
response.write "Could not find zipcode for Ship To address.
" & vbcrlf
exit function
end if
'----- intStep values 0=Commercial, 1=Residential -----
dim intStep, strProduct, fltPrice
intStep = 1
fltPrice = 0
strProduct = UPS_GetShipCode(intShipOption)
aryShipUPS_Matrix = UPS_InitPage(intStep, STR_UPS_ACTION, intShipWeight, strZip, blnDebugcode)
if blnDebugcode then ' and false debug code
dim xCnt, maxOption
maxOption = ubound(aryShipUPS_Matrix)
response.write "" & vbcrlf
for xCnt = 0 to maxOption
response.write aryShipUPS_Matrix(xCnt,0) & " : " & aryShipUPS_Matrix(xCnt,1) & "
" & vbcrlf
next
response.write "
" & vbcrlf
Draw_UPS_DebugFooter
end if
UPS_Trans_Run = fltPice
end function
'-------------- UPS_GetShipCode ------------------
function UPS_GetShipCode(intShipOption)
select case intShipOption
case 2
strShipCode = "GND"
strShipType = "Ground"
case 3
strShipCode = "3DS"
strShipType = "3 Day Select"
case 4
strShipCode = "2DA"
strShipType = "2nd Day Air"
case 5
strShipCode = "1DA"
strShipType = "Next Day Air"
case 6
strShipCode = "1DM"
strShipType = "Next Day Air Early AM"
case 7
strShipCode = "1DAPI"
strShipType = "Next Day Air Intra (Puerto Rico)"
case 8
strShipCode = "1DP"
strShipType = "Next Day Air Saver"
case 9
strShipCode = "2DM"
strShipType = "2nd Day Air AM"
case 10
strShipCode = "STD"
strShipType = "Canada Standard"
case 11
strShipCode = "XPR"
strShipType = "Worldwide Express"
case 12
strShipCode = "XDM"
strShipType = "Worldwide Express Plus"
case 13
strShipCode = "XPD"
strShipType = "Worldwide Expedited"
case else
' strShipCode = "GND"
' strShipType = "Ground"
' intShipOption = 2
end select
if strShipType <> "" then
strShipType = "UPS " & strShipType
end if
if blnDebugcode then ' Debug Code
response.write "Option: " & intShipOption & " UPS_GetShipCode: " & strShipCode & " " & strShipType & "
" & vbcrlf
end if
UPS_GetShipCode = strShipCode
end function
%>