<%
'This code is copyright (c) Internet Business Solutions SL, all rights reserved.
'The contents of this file are protect under law as the intellectual property
'of Internet Business Solutions SL. Any use, reproduction, disclosure or copying
'of any kind without the express and written permission of Internet Business 
'Solutions SL is forbidden.
'Author: Vince Reid, vince@virtualred.net
Private Sub ParseService(ochild, byRef packCost)
Dim s, l
For l = 0 To ochild.childNodes.length - 1
	Set s = ochild.childNodes.Item(l)
	Select Case s.nodeName
		Case "Pounds"
		Case "Ounces"
		Case "MailType"
		Case "Country"
		Case "Postage"
			if s.firstChild.nodeValue > packCost then packCost = s.firstChild.nodeValue
		Case "SvcCommitments"
		Case "SvcDescription"
		Case "MaxDimensions"
		Case "MaxWeight"
	End Select
Next
End Sub

Function ParseXMLOutput(sXML, international, byRef totalCost, byRef errormsg, byRef intShipping)
Dim noError, nodeList, packCost, xmlDoc, e, i, j, k, l, n, t, t2, s2
	noError = True
	totalCost = 0
	packCost = 0
	errormsg = ""
	gotxml=false
	on error resume next
	err.number=0
	set xmlDoc = Server.CreateObject("MSXML2.DOMDocument")
	if err.number=0 then gotxml=true
	if NOT gotxml then
		err.number=0
		set xmlDoc = Server.CreateObject("MSXML.DOMDocument")
		if err.number=0 then gotxml=true
	end if
	on error goto 0
	xmlDoc.validateOnParse = False
	xmlDoc.loadXML (sXML)
	If xmlDoc.documentElement.nodeName = "Error" then 'Top-level Error
		noError = False
		Set nodeList = xmlDoc.getElementsByTagName("Error")
		Set n = nodeList.Item(0)
		For i = 0 To n.childNodes.length - 1
			Set e = n.childNodes.Item(i)
			Select Case e.nodeName
				Case "Source"
				Case "Number"
				Case "Description"
					errormsg = e.firstChild.nodeValue
				Case "HelpFile"
				Case "HelpContext"
			End Select
		Next
	Else 'no Top-level Error
		Set nodeList = xmlDoc.getElementsByTagName("Package")
		For i = 0 To nodeList.length - 1
			Set n = nodeList.Item(i)
			For j = 0 To n.childNodes.length - 1
				Set e = n.childNodes.Item(j)
				If e.nodeName = "Error" Then 'Lower-level error
					noError = False
					For k = 0 To e.childNodes.length - 1
						Set t = e.childNodes.Item(k)
						Select Case t.nodeName
							Case "Source"
							Case "Number"
							Case "Description"
								errormsg = t.firstChild.nodeValue
							Case "HelpFile"
							Case "HelpContext"
						End Select
					Next
				else
					Select Case e.nodeName
						Case "ZipOrigination"
						Case "ZipDestination"
						Case "Pounds"
						Case "Ounces"
						Case "Zone"
						Case "Postage"
							' packCost = packCost + e.firstChild.nodeValue
							if international = "" then
								l = 0
								do while (intShipping(0, l) <> thisService AND intShipping(0, l) <> "")
									l = l + 1
								loop
								intShipping(0, l) = thisService
								if thisService="PARCEL" then
									intShipping(1, l) = "2-7 Days"
								elseif thisService="EXPRESS" then
									intShipping(1, l) = "Overnight to most areas"
								elseif thisService="PRIORITY" then
									intShipping(1, l) = "1-2 Days"
								elseif thisService="BPM" then
									intShipping(1, l) = "2-7 Days"
								elseif thisService="Media" then
									intShipping(1, l) = "2-7 Days"
								end if
								intShipping(2, l) = intShipping(2, l) + e.firstChild.nodeValue
								intShipping(3, l) = intShipping(3, l) + 1
							end if
						Case "RestrictionCodes"
						Case "RestrictionDescription"
						Case "Service"
							if international <> "" then
								Set t2 = e.getElementsByTagName("SvcDescription")
								Set s2 = t2.Item(0)
								l = 0
								do while (intShipping(0, l) <> s2.firstChild.nodeValue AND intShipping(0, l) <> "")
									l = l + 1
								loop
								intShipping(0, l) = s2.firstChild.nodeValue
								Set t2 = e.getElementsByTagName("SvcCommitments")
								Set s2 = t2.Item(0)
								intShipping(1, l) = s2.firstChild.nodeValue
								Set t2 = e.getElementsByTagName("Postage")
								Set s2 = t2.Item(0)
								intShipping(2, l) = intShipping(2, l) + s2.firstChild.nodeValue
								intShipping(3, l) = intShipping(3, l) + 1
								'Call ParseService(e,packCost)
							else
								thisService = e.firstChild.nodeValue
							end if
					End Select
				End If
			Next
			totalCost = totalCost + packCost
			packCost = 0
		Next
	End If
	ParseXMLOutput = noError
end Function
Function checkUPSShippingMeth(method)
	retval = false
	for xx=0 to UBOUND(uspsmethods,2)
		if method=uspsmethods(0,xx) then
			retval=true
			exit for
		end if
	next
	checkUPSShippingMeth = retval
End Function
Function ParseUPSXMLOutput(xmlDoc, international, byRef totalCost, byRef errormsg, byRef errorcode, byRef intShipping)
Dim noError, nodeList, packCost, e, i, j, k, l, n, t, t2, indexus
	noError = True
	totalCost = 0
	packCost = 0
	indexus = 0
	errormsg = ""
	Set t2 = xmlDoc.getElementsByTagName("RatingServiceSelectionResponse").Item(0)
	for j = 0 to t2.childNodes.length - 1
		Set n = t2.childNodes.Item(j)
		if n.nodename="Response" then
			For i = 0 To n.childNodes.length - 1
				Set e = n.childNodes.Item(i)
				if e.nodeName="ResponseStatusCode" then
					noError = Int(e.firstChild.nodeValue)=1
				end if
				if e.nodeName="Error" then
					errormsg = ""
					For k = 0 To e.childNodes.length - 1
						Set t = e.childNodes.Item(k)
						Select Case t.nodeName
							Case "ErrorCode"
								errorcode = t.firstChild.nodeValue
							Case "ErrorSeverity"
								if t.firstChild.nodeValue="Transient" then errormsg = "This is a temporary error. Please wait a few moments then refresh this page.<br>" & errormsg
							Case "ErrorDescription"
								errormsg = errormsg & t.firstChild.nodeValue
						End Select
					Next
				end if
				' response.write "The Nodename is : " & e.nodeName & ":" & e.firstChild.nodeValue & "<BR>"
			Next
		elseif n.nodename="RatedShipment" then
			wantthismethod=true
			For i = 0 To n.childNodes.length - 1
				Set e = n.childNodes.Item(i)
				Select Case e.nodeName
					Case "Service"
						For k = 0 To e.childNodes.length - 1
							Set t = e.childNodes.Item(k)
							if t.nodeName = "Code" then
								Select Case cStr(t.firstChild.nodeValue)
									Case "01"
										intShipping(0, l) = "UPS Next Day Air&reg;"
									Case "02"
										intShipping(0, l) = "UPS 2nd Day Air&reg;"
									Case "03"
										intShipping(0, l) = "UPS Ground"
									Case "07"
										intShipping(0, l) = "UPS Worldwide Express"
									Case "08"
										intShipping(0, l) = "UPS Worldwide Expedited"
									Case "11"
										intShipping(0, l) = "UPS Standard"
									Case "12"
										intShipping(0, l) = "UPS 3 Day Select&reg;"
									Case "13"
										intShipping(0, l) = "UPS Next Day Air Saver&reg;"
									Case "14"
										intShipping(0, l) = "UPS Next Day Air&reg; Early A.M.&reg;"
									Case "54"
										intShipping(0, l) = "UPS Worldwide Express Plus"
									Case "59"
										intShipping(0, l) = "UPS 2nd Day Air A.M.&reg;"
									Case "65"
										intShipping(0, l) = "UPS Express Saver"
								End Select
								wantthismethod = checkUPSShippingMeth(t.firstChild.nodeValue)
							end if
						Next
					Case "TotalCharges"
						For k = 0 To e.childNodes.length - 1
							Set t = e.childNodes.Item(k)
							if t.nodeName = "MonetaryValue" then intShipping(2, l) = cDbl(t.firstChild.nodeValue)
						Next
					Case "GuaranteedDaysToDelivery"
						if e.childNodes.length > 0 then
							if e.firstChild.nodeValue="1" then
								intShipping(1, l) = "1 day" & intShipping(1, l)
							else
								intShipping(1, l) = e.firstChild.nodeValue & " days" & intShipping(1, l)
							end if
						end if
					Case "ScheduledDeliveryTime"
						if e.childNodes.length > 0 then intShipping(1, l) = intShipping(1, l) & " by " & e.firstChild.nodeValue
				End select
			Next
			if wantthismethod=true then 
				intShipping(3, l) = true
				l = l + 1
			else
				intShipping(1, l) = ""
			end if
			wantthismethod=true
			' response.write "The RatedShipment is : " & n.nodeName & ":" & n.firstChild.nodeValue & "<BR>"
		end if
	Next
	ParseUPSXMLOutput = noError
end Function

function addDomestic(id,service,orig,dest,pounds,ounces,container,size,machinable)
	Dim sXML
	sXML = ""
	if IsArray(uspsmethods) then
		for indexus=0 TO UBOUND(uspsmethods,2)
			sXML = sXML & "<Package ID="""&uspsmethods(0,indexus)&id&""">"
			sXML = sXML & "<Service>"&uspsmethods(0,indexus)&"</Service>"
			sXML = sXML & "<ZipOrigination>"&orig&"</ZipOrigination>"
			sXML = sXML & "<ZipDestination>"&dest&"</ZipDestination>"
			sXML = sXML & "<Pounds>"&pounds&"</Pounds>"
			sXML = sXML & "<Ounces>"&ounces&"</Ounces>"
			sXML = sXML & "<Container>"&container&"</Container>"
			sXML = sXML & "<Size>"&size&"</Size>"
			sXML = sXML & "<Machinable>"&machinable&"</Machinable>"
			sXML = sXML & "</Package>"
		next
	end if
	addDomestic = sXML
end function

function addInternational(id,pounds,ounces,mailtype,country)
	Dim sXML
	sXML = "<Package ID="""&id&""">"
		sXML = sXML & "<Pounds>"&pounds&"</Pounds>"
		sXML = sXML & "<Ounces>"&ounces&"</Ounces>"
		sXML = sXML & "<MailType>"&mailtype&"</MailType>"
		sXML = sXML & "<Country>"&country&"</Country>"
	addInternational = sXML & "</Package>"
end function

function addUPSInternational(iWeight,adminUnits,packTypeCode,country,packcost)
	Dim sXML
	sXML = "<Package><PackagingType><Code>"&packTypeCode&"</Code><Description>Package</Description></PackagingType>"
	sXML = sXML & "<Description>Rate Shopping</Description><PackageWeight><UnitOfMeasurement><Code>"&adminUnits&"</Code></UnitOfMeasurement><Weight>"&iWeight&"</Weight></PackageWeight>"
	if addshippinginsurance=1 OR (addshippinginsurance=2 AND Trim(request.form("wantinsurance"))="Y") then
		if packcost > 999 then packcost=999
		sXML = sXML & "<PackageServiceOptions><InsuredValue><CurrencyCode>" & countryCurrency & "</CurrencyCode><MonetaryValue>" & FormatNumber(packcost,2,-1,0,0) & "</MonetaryValue></InsuredValue></PackageServiceOptions>"
	end if
	addUPSInternational = sXML & "</Package>"
end function

function USPSCalculate(sXML,international,byRef totalCost, byRef errormsg, byRef intShipping)
	Dim objHttp, i

	set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
	objHttp.open "POST", "http://production.shippingapis.com/ShippingAPI.dll", false
	
	on error resume next
	err.number=0
	objHttp.Send "API="&international&"Rate&XML=" & Server.URLEncode(sXML)
	on error goto 0
	for i=0 to UBOUND(intShipping,2)
		intShipping(0,i)=""
		intShipping(1,i)=""
		intShipping(2,i)=0
		intShipping(3,i)=false
	next
	If err.number <> 0 OR objHttp.status <> 200 Then
		errormsg = "Error, couldn't connect to USPS server"
		USPSCalculate = false
	Else
		saveLCID = Session.LCID
		Session.LCID = 1033
		USPSCalculate = ParseXMLOutput(objHttp.responseText, international, totalCost, errormsg, intShipping)
		Session.LCID = saveLCID
	End If
	set objHttp = nothing
end function

function UPSCalculate(sXML,international,byRef totalCost, byRef errormsg, byRef intShipping)
	Dim objHttp, i
	set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
	objHttp.open "POST", "https://www.ups.com/ups.app/xml/Rate", false
	objHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	' response.write Replace(Replace(sXML,"</","&lt;/"),"<","<br>&lt;")&"<HR>"
	on error resume next
	err.number=0
	objHttp.Send sXML
	on error goto 0
	for i=0 to UBOUND(intShipping,2)
		intShipping(0,i)=""
		intShipping(1,i)=""
		intShipping(2,i)=0
		intShipping(3,i)=0
	next
	If err.number <> 0 OR objHttp.status <> 200 Then
		errormsg = "Error, couldn't connect to UPS server"
		UPSCalculate = false
	Else
		saveLCID = Session.LCID
		Session.LCID = 1033
		' response.write Replace(Replace(objHttp.responseText,"</","&lt;/"),"<","<br>&lt;")&"<HR>"
		UPSCalculate = ParseUPSXMLOutput(objHttp.responseXML, international, totalCost, errormsg, errorcode, intShipping)
		if errorcode = 111210 then errormsg = "The destination zip / postal code is invalid."
		Session.LCID = saveLCID
	End If
	set objHttp = nothing
end function
%>