<%
'Reference Dictionaries - used inside object (Where to place these?)
function UPS_dctResponseStatusCode
set UPS_dctResponseStatusCode = Server.CreateObject("Scripting.Dictionary")
UPS_dctResponseStatusCode.Add "200", "Request Processed succesfully."
UPS_dctResponseStatusCode.Add "240", "Request Processed, some warnings exist. Check XML."
UPS_dctResponseStatusCode.Add "250", "Request could not be processed. Check XML."
UPS_dctResponseStatusCode.Add "500", "UPS OnLine Toole unavailable; try again later."
end function
function UPS_dctPickupTypes
set UPS_dctPickupTypes = Server.CreateObject("Scripting.Dictionary")
UPS_dctPickupTypes.Add "1", "Daily Pickup"
UPS_dctPickupTypes.Add "3", "Customer Counter"
UPS_dctPickupTypes.Add "6", "One Time Pickup"
UPS_dctPickupTypes.Add "7", "On Call Air Pickup®"
UPS_dctPickupTypes.Add "19", "Letter Center"
UPS_dctPickupTypes.Add "20", "Air Service Center"
end function
function UPS_dctPackageTypes
set UPS_dctPackageTypes = Server.CreateObject("Scripting.Dictionary")
UPS_dctPackageTypes.Add "0", "Unknown"
UPS_dctPackageTypes.Add "1", "UPS Letter"
UPS_dctPackageTypes.Add "2", "Package"
UPS_dctPackageTypes.Add "3", "UPS Tube"
UPS_dctPackageTypes.Add "4", "UPS Pak"
UPS_dctPackageTypes.Add "21", "UPS Express Box"
UPS_dctPackageTypes.Add "24", "UPS 25Kg Box®"
UPS_dctPackageTypes.Add "25", "UPS 10Kg Box®"
end function
function UPS_dctServiceCodes
set UPS_dctServiceCodes = Server.CreateObject("Scripting.Dictionary")
UPS_dctServiceCodes.Add "1", "UPS Next Day Air"
UPS_dctServiceCodes.Add "2", "UPS 2nd Day Air"
UPS_dctServiceCodes.Add "3", "UPS Ground"
UPS_dctServiceCodes.Add "7", "UPS Worldwide ExpressSM"
UPS_dctServiceCodes.Add "8", "UPS Worldwide ExpeditedSM"
UPS_dctServiceCodes.Add "11", "UPS Standard"
UPS_dctServiceCodes.Add "12", "UPS 3 Day Select®"
UPS_dctServiceCodes.Add "13", "UPS Next Day Air Saver®"
UPS_dctServiceCodes.Add "14", "UPS Next Day Air® Early A.M.®"
UPS_dctServiceCodes.Add "54", "UPS Worldwide Express PlusSM"
UPS_dctServiceCodes.Add "59", "UPS 2nd Day Air A.M.®"
UPS_dctServiceCodes.Add "64", "N/A"
UPS_dctServiceCodes.Add "65", "UPS Express Saver"
end function
'Fix leading 0
function SafeUPSCode(intCode)
if intCode < 10 then
SafeUPSCode = "0" & intCode
else
SafeUPSCode = intCode
end if
end function
function UPS_CustomerClassificationCode(intPickUpType)
'Based upon UPS's "Rates & Service Selection" [Appendix B - Table 6] Rate Chart usage based on pickup type and customer classification
set UPS_CustomerClassificationCode = Server.CreateObject("Scripting.Dictionary")
if IsNumeric(intPickUpType) then
intPickUpType = CInt(intPickUpType)
select case intPickUpType
case 1
UPS_CustomerClassificationCode.Add "1", "Wholesale"
UPS_CustomerClassificationCode.Add "3", "Occasional"
UPS_CustomerClassificationCode.Add "4", "Retail"
case 3, 6, 7, 19, 20
UPS_CustomerClassificationCode.Add "1", "Occasional"
UPS_CustomerClassificationCode.Add "3", "Occasional"
UPS_CustomerClassificationCode.Add "4", "Occasional"
case 11
UPS_CustomerClassificationCode.Add "1", "Retail"
UPS_CustomerClassificationCode.Add "3", "Retail"
UPS_CustomerClassificationCode.Add "4", "Retail"
case 20
end select
end if
end function
class UPSManager
private strUserName
private strPassword
private strLicense
private blnDebug
private aryShipments()
private intShipments
'Sets
public property let UserName(strInput)
if not blnDebug then strUserName = strInput
end property
public property let Password(strInput)
if not blnDebug then strPassword = strInput
end property
public property let License(strInput)
if not blnDebug then strLicense = strInput
end property
public property let Debug(blnInput)
if not blnDebug then blnDebug = blnInput
end property
'Gets ?Do we want this available?
public property get UserName()
UserName = strUserName
end property
public property get Password()
Password = strPassword
end property
public property get License()
License = strLicense
end property
'Constructor
private sub Class_Initialize()
blnDebug = false
intShipments = 0
end sub
'Destructor
private sub Class_Terminate()
dim i
'Kill the Packages
for i=0 to (intShipments-1)
set aryShipments(i) = nothing
next
end sub
public sub AddShipment(objShipment)
redim preserve aryShipments(intShipments)
set aryShipments(intShipments) = objShipment
intShipments = intShipments + 1
end sub
'Used for debugging purposes
public sub SetDebug()
blnDebug = true
strUserName = "awsadmin"
strPassword = "5fingers"
strLicense = "3BA97C3A90D4B3D2"
response.write "**************** DEBUG MODE *********************
"
end sub
public function Init(UserNameStr, PasswordStr, LicenseStr)
if not blnDebug then
strUserName = UserNameStr
strPassword = PasswordStr
strLicense = LicenseStr
' response.write "**************** " & strUserName & " *********************
"
end if
end function
public function Process()
dim objShipment
Process = false
if not IsNull(strUserName) and not IsNull(strPassword) and not IsNull(strLicense) then
for each objShipment in aryShipments
Process = ConsumeXML( objShipment, HTTPPost( GetXMLAccessRequest() & GetXMLRateRequest(objShipment) ) )
if Process = false then
exit function
end if
next
end if
end function
private function GetXMLAccessRequest()
GetXMLAccessRequest = GetXMLAccessRequest & "" & vbcrlf
GetXMLAccessRequest = GetXMLAccessRequest & "" & vbcrlf
GetXMLAccessRequest = GetXMLAccessRequest & "" & strLicense & "" & vbcrlf
GetXMLAccessRequest = GetXMLAccessRequest & "" & strUserName & "" & vbcrlf
GetXMLAccessRequest = GetXMLAccessRequest & "" & strPassword & "" & vbcrlf
GetXMLAccessRequest = GetXMLAccessRequest & "" & vbcrlf
if blnDebug then
response.write "-------------------------------REQUEST----------------------------
"
response.write Server.HTMLEncode(GetXMLAccessRequest) & "
"
end if
end function
private function GetXMLRateRequest(objShipment)
dim objPackage
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "Rating and Service" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "1.0001" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "Rate" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "shop" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "01" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
if not IsNull(objShipment.ShipperCity) then
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipperCity & "" & vbcrlf
end if
if not IsNull(objShipment.ShipperState) then
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipperState & "" & vbcrlf
end if
if not IsNull(objShipment.ShipperCountryCode) then
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipperCountryCode & "" & vbcrlf
end if
'Postal code required
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipperPostalCode & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
if objShipment.Residential then
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
end if
if not IsNull(objShipment.ShipToCity) then
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipToCity & "" & vbcrlf
end if
if not IsNull(objShipment.ShipToState) then
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipToState & "" & vbcrlf
end if
if not IsNull(objShipment.ShipToCountryCode) then
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipToCountryCode & "" & vbcrlf
end if
'Postal code required
GetXMLRateRequest = GetXMLRateRequest & "" & objShipment.ShipToPostalCode & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & SafeUPSCode(objShipment.ServiceCode) & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
for each objPackage in objShipment.Packages
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & SafeUPSCode(objPackage.PackageType) & "" & vbcrlf
'GetXMLRateRequest = GetXMLRateRequest & "Package" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
'GetXMLRateRequest = GetXMLRateRequest & "Rate Shopping" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & objPackage.TotalWeight & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
next
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
GetXMLRateRequest = GetXMLRateRequest & "" & vbcrlf
if blnDebug then
response.write Server.HTMLEncode(GetXMLRateRequest) & "
"
response.write "------------------------------------------------------------------
"
end if
end function
private function HTTPPost(strRequest)
dim objHTTP
set objHTTP = Server.CreateObject("Msxml2.XMLHTTP")
if not blnDebug then
objHTTP.open "post", "https://www.ups.com/ups.app/xml/Rate", false
else
objHTTP.open "post", "https://wwwcie.ups.com/ups.app/xml/Rate", false
end if
'---------------- TEST xml file --------------------
'Uncomment for live
objHTTP.send(strRequest)
'---------------- TEST xml file --------------------
set HTTPPost = objHTTP
end function
'The mama XML parser
private function ConsumeXML(objShipment, objHTTP)
dim dctResponseStatusCodes
dim intResponseCode
dim objXMLDOM
dim objDOMROOT
dim objDOMLISTShipment
dim objDOMNODE
dim objXMLNode
dim objUPSRate
set dctResponseStatusCodes = UPS_dctResponseStatusCode
'---------------- TEST xml file --------------------
'Uncomment for live
intResponseCode = objHTTP.status
'---------------- TEST xml file --------------------
if blnDebug then
response.write "-------------------------------RESPONSE----------------------------
"
response.write "STATUS CODE: " & intResponseCode & "
"
response.write "STATUS MESSAGE: " & dctResponseStatusCodes( CStr(intResponseCode) ) & "
"
end if
if intResponseCode = 200 then
ConsumeXML = true
else
ConsumeXML = false
'---------------- TEST xml file --------------------
'Uncomment for live
exit function
'---------------- TEST xml file --------------------
end if
if blnDebug then
response.write Server.HTMLEncode(objHTTP.responseXML.xml) & "
"
response.write "------------------------------------------------------------------
"
end if
'---------------- TEST xml file --------------------
'Comment for live
'set objXMLDOM = Server.CreateObject("Msxml2.DOMDocument")
'objXMLDOM.async = false
'objXMLDOM.resolveExternals = false
'objXMLDOM.load("D:\projects\anniescharmcloset\FixIt\response.xml") 'Loading from saved xml for test
'---------------- TEST xml file --------------------
'Consume shipment info
'---------------- TEST xml file --------------------
'Uncomment for live
set objXMLDOM = objHTTP.responseXML
'---------------- TEST xml file --------------------
set objDOMROOT = objXMLDOM.documentElement
set objDOMLISTShipment = objDOMROOT.selectNodes("RatedShipment")
for each objDOMNODE in objDOMLISTShipment
set objUPSRate = new UPSRate
'Set Service type
set objXMLNode = objDOMNODE.selectSingleNode("Service/Code")
objUPSRate.ServiceCode = objXMLNode.text
'Transportation Cost
set objXMLNode = objDOMNODE.selectSingleNode("TransportationCharges/MonetaryValue")
objUPSRate.TransportCost = objXMLNode.text
'Total Cost
set objXMLNode = objDOMNODE.selectSingleNode("TotalCharges/MonetaryValue")
objUPSRate.TotalCost = objXMLNode.text
objShipment.AddUPSRate(objUPSRate)
next
'Show Rates
if blnDebug then
response.write "residential = " & objShipment.Residential & "
" & vbcrlf
for each objUPSRate in objShipment.UPSRates
response.write objUPSRate.ServiceName & ": " & FormatCurrency(objUPSRate.TotalCost) & "
"
next
end if
set dctResponseStatusCodes = nothing
'---------------- TEST xml file --------------------
'Comment for live
'response.end
'---------------- TEST xml file --------------------
set objHTTP = nothing
end function
end class
class Shipment
private intServiceCode 'See UPS_dctServiceCodes
private strServiceName 'See UPS_dctServiceCodes
private intPickupType 'See UPS_dctPickupTypes
private blnResidential 'If is true then the is added
private strShipperCity
private chrShipperState
private chrShipperCountryCode
private lngShipperPostalCode
private strShipToCity
private chrShipToState
private chrShipToCountryCode
private lngShipToPostalCode
private aryPackages()
private intPackages
private aryUPSRates()
private intUPSRates
'Sets
public property let ServiceCode(intInput)
dim dctServiceCodes
if IsNumeric(intInput) then
intServiceCode = CInt(intInput)
set dctServiceCodes = UPS_dctServiceCodes
strServiceName = dctServiceCodes( CStr(intServiceCode) )
set dctServiceCodes = nothing
end if
end property
public property let PickupType(intInput)
if IsNumeric(intInput) then intPickupType = CInt(intInput)
end property
public property let ShipperCity(strInput)
strShipperCity = strInput
end property
public property let ShipperState(chrInput)
chrShipperState = chrInput
end property
public property let ShipperCountryCode(chrInput)
chrShipperCountryCode = chrInput
end property
public property let ShipperPostalCode(lngInput)
if IsNumeric(lngInput) then lngShipperPostalCode = CLng(lngInput)
end property
public property let ShipToCity(strInput)
strShipToCity = strInput
end property
public property let ShipToState(chrInput)
chrShipToState = chrInput
end property
public property let ShipToCountryCode(chrInput)
chrShipToCountryCode = chrInput
end property
public property let ShipToPostalCode(lngInput)
if IsNumeric(lngInput) then lngShipToPostalCode = CLng(lngInput)
end property
public property let Residential(blnInput)
blnResidential = CBool(blnInput)
end property
'Gets
public property get ShipperCity()
ShipperCity = strShipperCity
end property
public property get ShipperState()
ShipperState = chrShipperState
end property
public property get ShipperCountryCode()
ShipperCountryCode = chrShipperCountryCode
end property
public property get ShipperPostalCode()
ShipperPostalCode = lngShipperPostalCode
end property
public property get ShipToCity()
ShipToCity = strShipToCity
end property
public property get ShipToState()
ShipToState = chrShipToState
end property
public property get ShipToCountryCode()
ShipToCountryCode = chrShipToCountryCode
end property
public property get ShipToPostalCode()
ShipToPostalCode = lngShipToPostalCode
end property
public property get Residential()
Residential = blnResidential
end property
public property get ServiceCode()
ServiceCode = intServiceCode
end property
public property get ServiceName()
ServiceName = strServiceName
end property
public property get Packages()
Packages = aryPackages
end property
public property get UPSRates()
UPSRates = aryUPSRates
end property
'Constructor
private sub Class_Initialize()
'Set defaults
dim dctServiceCodes
set dctServiceCodes = UPS_dctServiceCodes
intServiceCode = 3 'UPS Ground
strServiceName = dctServiceCodes( CStr(intServiceCode) )
intPickupType = 1 'Daily Pickup
intPackages = 0
intUPSRates = 0
blnResidential = false
set dctServiceCodes = nothing
end sub
'Destructor
private sub Class_Terminate()
dim i
'Kill the Packages
for i=0 to (intPackages-1)
set aryPackages(i) = nothing
next
'Kill the Rates
for i=0 to (intUPSRates-1)
set aryUPSRates(i) = nothing
next
end sub
public sub AddPackage(objPackage)
redim preserve aryPackages(intPackages)
set aryPackages(intPackages) = objPackage
intPackages = intPackages + 1
end sub
public sub AddUPSRate(objRate)
redim preserve aryUPSRates(intUPSRates)
set aryUPSRates(intUPSRates) = objRate
intUPSRates = intUPSRates + 1
end sub
end class
class Package
private dblContentWeight 'lbs
private dblPackagingWeight 'lbs
private intPackageType 'See UPS_dctPackageTypes
private dblLength 'inches
private dblWidth 'inches
private dblHeight 'inches
private strDescription
'Sets
public property let ContentWeight(dblInput)
if IsNumeric(dblInput) then dblContentWeight = CDbl(dblInput)
end property
public property let PackagingWeight(dblInput)
if IsNumeric(dblInput) then dblPackagingWeight = CDbl(dblInput)
end property
public property let Length(dblInput)
if IsNumeric(dblInput) then dblLength = CDbl(dblInput)
end property
public property let Width(dblInput)
if IsNumeric(dblInput) then dblWidth = CDbl(dblInput)
end property
public property let Height(dblInput)
if IsNumeric(dblInput) then dblHeight = CDbl(dblInput)
end property
public property let PackageType(intInput)
if IsNumeric(intInput) then intPackageType = CInt(intInput)
end property
public property let Description(strInput)
strDescription = strInput
end property
'Gets
public property get ContentWeight()
ContentWeight = dblContentWeight
end property
public property get PackagingWeight()
PackagingWeight = dblPackagingWeight
end property
public property get Length()
Length = dblLength
end property
public property get Width()
Width = dblWidth
end property
public property get Height()
Height = dblHeight
end property
public property get PackageType()
PackageType = intPackageType
end property
public property get Description()
Description = strDescription
end property
public property get TotalWeight()
TotalWeight = dblContentWeight + dblPackagingWeight
end property
'Constructor
private sub Class_Initialize()
'Set Standard dimensions
dblLength = 11
dblWidth = 9
dblHeight = 4
dblContentWeight = 1
dblPackagingWeight = 0.5
intPackageType = 2
strDescription = "Rate Shopping"
end sub
end class
class UPSRate 'Modeled from UPS:RatedShipment (www.ups.com)
private curTransportCost
private curTotalCost
private intServiceCode
private strServiceName
'Sets
public property let ServiceCode(intInput)
dim dctServiceCodes
if IsNumeric(intInput) then
intServiceCode = CInt(intInput)
set dctServiceCodes = UPS_dctServiceCodes
strServiceName = dctServiceCodes( CStr(intServiceCode) )
set dctServiceCodes = nothing
end if
end property
public property let TransportCost(curInput)
if IsNumeric(curInput) then curTransportCost = CCur(curInput)
end property
public property let TotalCost(curInput)
if IsNumeric(curInput) then curTotalCost = CCur(curInput)
end property
'Gets
public property get TransportCost()
TransportCost = curTransportCost
end property
public property get TotalCost()
TotalCost = curTotalCost
end property
public property get ServiceCode()
ServiceCode = intServiceCode
end property
public property get ServiceName()
ServiceName = strServiceName
end property
end class
%>