<% '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 Dim netnav netnav = true if instr(Request.ServerVariables("HTTP_USER_AGENT"), "compatible") > 0 OR instr(Request.ServerVariables("HTTP_USER_AGENT"), "Gecko") > 0 then netnav = false function atb(size) if netnav then atb = CInt(size / 2 + 1) else atb = size end if end function Set rs = Server.CreateObject("ADODB.RecordSet") Set cnn=Server.CreateObject("ADODB.Connection") cnn.open sDSN alreadygotadmin = getadminsettings() %>
<% Function getAddress(t, byRef theAddress) signedby = "" For l = 0 To t.childNodes.length - 1 Set u = t.childNodes.Item(l) if u.nodeName = "AddressLine1" then addressline1 = u.firstChild.nodeValue elseif u.nodeName = "AddressLine2" then addressline2 = u.firstChild.nodeValue elseif u.nodeName = "AddressLine3" then addressline3 = u.firstChild.nodeValue elseif u.nodeName = "City" then city = u.firstChild.nodeValue elseif u.nodeName = "StateProvinceCode" then statecode = u.firstChild.nodeValue elseif u.nodeName = "PostalCode" then postcode = u.firstChild.nodeValue elseif u.nodeName = "CountryCode" then sSQL = "SELECT countryName FROM countries WHERE countryCode='" & u.firstChild.nodeValue & "'" rs.Open sSQL,cnn,0,1 if NOT rs.EOF then countrycode = rs("countryName") else countrycode = u.firstChild.nodeValue end if rs.Close end if next theAddress = "" if addressline1<>"" then theAddress = theAddress & addressline1 & "
" if addressline2<>"" then theAddress = theAddress & addressline2 & "
" if addressline3<>"" then theAddress = theAddress & addressline3 & "
" if city<>"" then theAddress = theAddress & city & "
" if statecode<>"" AND postcode<>"" then theAddress = theAddress & statecode & ", " & postcode & "
" else if statecode<>"" then theAddress = theAddress & statecode & "
" if postcode<>"" then theAddress = theAddress & postcode & "
" end if if countrycode<>"" then theAddress = theAddress & countrycode & "
" End Function Function ParseUPSTrackingOutput(sXML, byRef totActivity, byRef shipperNo, byRef serviceDesc, byRef shipperaddress, byRef shiptoaddress, byRef scheddeldate, byRef rescheddeldate, byRef errormsg, byRef activityList) Dim noError, nodeList, packCost, xmlDoc, e, i, j, k, n, t, t2, index noError = True totalCost = 0 packCost = 0 index = 0 errormsg = "" gotxml=false theaddress="" 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) Set t2 = xmlDoc.getElementsByTagName("TrackResponse").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 "ErrorSeverity" if t.firstChild.nodeValue="Transient" then errormsg = "This is a temporary error. Please wait a few moments then refresh this page.
" & errormsg Case "ErrorDescription" errormsg = errormsg & t.firstChild.nodeValue End Select Next end if ' response.write "The Nodename is : " & e.nodeName & ":" & e.firstChild.nodeValue & "
" Next elseif n.nodename="Shipment" then For i = 0 To n.childNodes.length - 1 Set e = n.childNodes.Item(i) ' response.write "Nodename is : " & e.nodeName & "
" Select Case e.nodeName Case "Shipper" For k = 0 To e.childNodes.length - 1 Set t = e.childNodes.Item(k) if t.nodeName = "ShipperNumber" then shipperNo = t.firstChild.nodeValue elseif t.nodeName = "Address" then call getAddress(t, shipperaddress) end if Next Case "ShipTo" For k = 0 To e.childNodes.length - 1 Set t = e.childNodes.Item(k) if t.nodeName = "Address" then call getAddress(t, shiptoaddress) end if Next Case "ScheduledDeliveryDate" scheddeldate = e.firstChild.nodeValue Case "Service" For k = 0 To e.childNodes.length - 1 Set t = e.childNodes.Item(k) if t.nodeName = "Code" then Select Case Int(t.firstChild.nodeValue) Case 1 serviceDesc = "Next Day Air" Case 2 serviceDesc = "2nd Day Air" Case 3 serviceDesc = "Ground Service" Case 7 serviceDesc = "Worldwide Express" Case 8 serviceDesc = "Worldwide Expedited" Case 11 serviceDesc = "Standard service" Case 12 serviceDesc = "3-Day Select" Case 13 serviceDesc = "Next Day Air Saver" Case 14 serviceDesc = "Next Day Air Early AM" Case 54 serviceDesc = "Worldwide Express Plus" Case 59 serviceDesc = "2nd Day Air AM" Case 64 serviceDesc = "UPS Express NA1" Case 65 serviceDesc = "Express Saver" End Select ' response.write "The service code is : " & t.nodeName & ":" & t.firstChild.nodeValue & "
" end if Next Case "Package" For k = 0 To e.childNodes.length - 1 Set t = e.childNodes.Item(k) if t.nodeName = "RescheduledDeliveryDate" then rescheddeldate = t.firstChild.nodeValue elseif t.nodeName = "Activity" then For l = 0 To t.childNodes.length - 1 Set u = t.childNodes.Item(l) if u.nodeName = "ActivityLocation" then For m = 0 To u.childNodes.length - 1 Set v = u.childNodes.Item(m) if v.nodeName = "Address" then call getAddress(v, activityList(totActivity,0)) elseif v.nodeName = "Description" then description = v.firstChild.nodeValue elseif v.nodeName = "SignedForByName" then activityList(totActivity,1) = v.firstChild.nodeValue end if Next elseif u.nodeName = "Status" then For m = 0 To u.childNodes.length - 1 Set v = u.childNodes.Item(m) if v.nodeName = "StatusType" then For nn = 0 To v.childNodes.length - 1 Set w = v.childNodes.Item(nn) if w.nodeName="Code" then activityList(totActivity,3)=w.firstChild.nodeValue elseif w.nodeName="Description" then activityList(totActivity,4)=w.firstChild.nodeValue end if next elseif v.nodeName = "StatusCode" then For nn = 0 To v.childNodes.length - 1 Set w = v.childNodes.Item(nn) if w.nodeName="Code" then activityList(totActivity,5)=w.firstChild.nodeValue end if next end if Next else if u.nodeName="Date" then activityList(totActivity,6)=u.firstChild.nodeValue elseif u.nodeName="Time" then activityList(totActivity,7)=u.firstChild.nodeValue end if end if Next totActivity = totActivity + 1 ' response.write "

" end if Next End select Next end if Next ParseUPSTrackingOutput = noError end Function function UPSTrack(trackNo) Dim objHttp, i, activityList(100,10),success,lastloc lastloc="xxxxxx" ' ActivityList(0) = Address ' ActivityList(1) = SignedForByName ' ActivityList(2) = Not Used ' ActivityList(3) = Activity -> Status -> StatusType -> Code ' ActivityList(4) = Activity -> Status -> StatusType -> Description ' ActivityList(5) = Activity -> Status -> StatusCode -> Code ' ActivityList(6) = Activity -> Date ' ActivityList(7) = Activity -> Time sXML = ""&upsAccess&""&upsUser&""&upsPw&"" sXML = sXML & "Example 31.0001Track" if Trim(request.form("activity"))="LAST" then sXML = sXML & "none" else sXML = sXML & "activity" sXML = sXML & "" if false then sXML = sXML & ""&trackNo&"" sXML = sXML & "116593" else sXML = sXML & ""&trackNo&"" end if set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") objHttp.open "POST", "https://www.ups.com/ups.app/xml/Track", false objHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" ' response.write Replace(Replace(sXML,"<")&"

" on error resume next err.number=0 objHttp.Send sXML on error goto 0 If err.number <> 0 OR objHttp.status <> 200 Then errormsg = "Error, couldn't connect to UPS server" success = false Else saveLCID = Session.LCID Session.LCID = 1033 totActivity = 0 ' response.write Replace(Replace(objHttp.responseText,"<")&"

" success = ParseUPSTrackingOutput(objHttp.responseText, totActivity, shipperNo, serviceDesc, shipperaddress, shiptoaddress, scheduleddeliverydate, rescheddeliverydate, errormsg, activityList) Session.LCID = saveLCID if success then for index2=0 to totActivity-2 for index=0 to totActivity-2 if Int(activityList(index,6)&activityList(index,7))>Int(activityList(index+1,6)&activityList(index+1,7)) then for index3=0 to UBOUND(activityList,2) tempArr = activityList(index,index3) activityList(index,index3)=activityList(index+1,index3) activityList(index+1,index3)=tempArr next end if next next if Trim(shipperNo)<>"" then %> <% end if if Trim(serviceDesc)<>"" then %> <% end if if Trim(shipperaddress)<>"" then %> <% end if if Trim(shiptoaddress)<>"" then %> <% end if if Trim(scheduleddeliverydate)<>"" then %> <% end if if Trim(rescheddeliverydate)<>"" then %> <% end if %>

UPS Tracking Tool

Shipper Number

<%=shipperNo%>

Service Description

<%=serviceDesc%>

Shipper Address

<%=shipperaddress%>

Ship-To Address

<%=shiptoaddress%>

Sched. Delivery Date

<%=DateSerial(Left(scheduleddeliverydate,4),Mid(scheduleddeliverydate,5,2),Mid(scheduleddeliverydate,7,2)) %>

ReSched. Delivery Date

<%=DateSerial(Left(rescheddeliverydate,4),Mid(rescheddeliverydate,5,2),Mid(rescheddeliverydate,7,2)) %>

Note

Your package is in the UPS system and has a rescheduled delivery date of <%=DateSerial(Left(rescheddeliverydate,4),Mid(rescheddeliverydate,5,2),Mid(rescheddeliverydate,7,2)) %>

<% for index=0 to totActivity-1 if index MOD 2 = 0 then cellbg="class=""cobll"" bgcolor=""#FFFFFF""" else cellbg="class=""cobhl"" bgcolor=""#EBEBEB""" end if %> <% next %>

Location	Description	Date / Time
><% if lastloc=activityList(index,0) then response.write " "" " else response.write activityList(index,0) lastloc = activityList(index,0) end if %>	><% response.write activityList(index,4) if activityList(index,1)<>"" then response.write " Signed By : " & activityList(index,1) %>	><%=DateSerial(Left(activityList(index,6),4),Mid(activityList(index,6),5,2),Mid(activityList(index,6),7,2))%> <%=TimeSerial(Left(activityList(index,7),2),Mid(activityList(index,7),3,2),Mid(activityList(index,7),5,2))%>

<% else %>

UPS Tracking returned the following error : <%=errormsg%>

<% end if End If UPSTrack = success set objHttp = nothing end function if Trim(Request.Form("trackno"))<>"" then UPSTrack(Trim(Request.Form("trackno"))) end if %>

Please enter your UPS Tracking Number :

" />

Show Activity :

/> By selecting this box and the "Track Package" button, I agree to these Terms and Conditions.

UPS®, UPS & Shield Design® and UNITED PARCEL SERVICE® are
registered trademarks of United Parcel Service of America, Inc.

<% cnn.Close set rs = nothing set cnn = nothing %>