<%Option Explicit%> <% '************************************************************* ' Version 6.50 ' UPS Tracking ' Nov 12, 2005 '*************************************************************** Dim action, theTrackNumber dim result, xmlerror Dim ShipperNumber,shiptoon,Addresson,activitystart,statustypeon,Trackingnumber2,Activitycount dim descriptionact(30),SignedForByName,statustypearr(30),shipdatearr(30),shiptimearr(30),theweight 'VP-ASP 6.09 - dim shipcity dim AddressLine1,AddressLine2,Cityarr(30),StateProvinceCodearr(30),PostalCode,CountryCodearr(30) dim theservice, servicestart, unitstart, theweightunit,Address 'VP-ASP 6.09 - set activitycount to 0 activitycount=0 action=Request.form("action") ShopPageHeader ShopOpenDatabase myconn If action="" Then DisplayForm else ProcessUserAction end if ShopCloseDatabase myconn ShopPageTrailer SUB ProcessUserAction DetermineOIDorTracking if serror = "" then SendTrackingRequest AnalyzeTrackXML If Statuscode=0 then Serror= "ERROR: " & Statusmessage & "
" ShopCloseDatabase myconn shoperror serror serror = "" end if DisplayResult else ShopCloseDatabase myconn shoperror serror serror = "" end if end sub Sub DisplayForm %>
Please enter your Order ID or UPS Tracking Number.
I agree to the following Tracking Terms and Conditions.

UPS, UPS brandmark, and the Color Brown are trademarks of United Parcel Service of America, Inc. All Rights Reserved.
<% End Sub Sub SendTrackingRequest dim xmlstring xmlstring=xmlstring & "" xmlstring=xmlstring & "" xmlstring=xmlstring & "" & getupsconfig("AccessLicenceNum",true, myconn) & "" xmlstring=xmlstring & "" & getupsconfig("Username",true, myconn) & "" xmlstring=xmlstring & "" & getupsconfig("Password",true, myconn) & "" xmlstring=xmlstring & "" xmlstring=xmlstring & "" xmlstring=xmlstring & "" xmlstring=xmlstring & "" xmlstring=xmlstring & "" xmlstring=xmlstring & "Example 1" xmlstring=xmlstring & "1.0001" xmlstring=xmlstring & "" xmlstring=xmlstring & " Track" xmlstring=xmlstring & " activity" xmlstring=xmlstring & " " xmlstring=xmlstring & "" & theTrackNumber & "" xmlstring=xmlstring & "" if getupsconfig("testmode",false, myconn) = "Yes" then Shopxmlhttp getupsconfig("xml",false, myconn), getupsconfig("gatewaylocation_trackingtesting",false, myconn), xmlstring, result, "POST", xmlerror else Shopxmlhttp getupsconfig("xml",false, myconn), getupsconfig("gatewaylocation_tracking",false, myconn), xmlstring, result, "POST", xmlerror end if End Sub 'VP-ASP - updated for greater security checking Sub DetermineOIDorTracking Dim upsoid upsoid = cleanchars(request("number")) If IsNull(upsoid) Or upsoid = "" Then shoperror "Invalid Order Number" End If if isnumeric(upsoid) then 'is an order id - need to get associated tracking number dim sql,rs sql = "SELECT upstrackno FROM orders WHERE orderid = " & upsoid set rs=myconn.execute(sql) if not rs.eof then theTrackNumber = rs("upstrackno") if (theTrackNumber = "") or (isNull(theTrackNumber)) then serror = "There is not a valid UPS Tracking Number associated with this order." end if else serror = "The number you have entered is not a valid UPS Tracking Number and does not correspond to an order in our system." end if set rs = nothing else theTrackNumber = upsoid end if End Sub Sub DisplayResult dim i,olddate,bgcolor,writedate %>
<% if theweight = 0 then %> <% else %> <% end if %>
Tracking Number Status  
<%=Trackingnumber2%> <%=Statustypearr(0)%> <% response.write ReturnDate(Shipdatearr(0)) & "," & ReturnTime(Shiptimearr(0)) response.write "
" & Descriptionact(0) response.write "
" & theservice %>
DETAIL Delivered On: <%=ReturnDate(Shipdatearr(0))%>
Shipped To: <% Response.write AddressLine1 if AddressLine2<>"" then Response.write "," & AddressLine2 'VP-ASP 6.09 - use shipcity instead of cityarr 'if CityArr(0)<>"" then Response.write "
" & Cityarr(0) if shipcity<>"" then Response.write "
" & shipcity if StateProvinceCodearr(0)<>"" then Response.write "
" & StateProvinceCodearr(0) if PostalCode <>"" then Response.write "
" & PostalCode if CountryCodearr(0)<>"" then Response.write "
" & CountryCodearr(0) %>
Package Type: LETTERPackage Weight: <%=theweight & " " & theweightunit%>

<% olddate="444444" For i= 0 to activitycount-1 if shipdatearr(i)=olddate then writedate=false else writedate=true end if if bgcolor="#ffffff" then bgcolor="#efefef" else bgcolor="#ffffff" end if olddate=shipdatearr(i) %> <% Next%>
Date Time Location Activity
<% if writedate=true then response.write Returndate(shipdatearr(i)) %> <%=ReturnTime(shiptimearr(i))%> <%=Cityarr(i)%> <%=Statustypearr(i)%>
 
 
NOTICE: The UPS package tracking systems accessed via this service (the “Tracking Systems”) and tracking information obtained through this service (the “Information”) are the private property of UPS. UPS authorizes you to use the Tracking Systems solely to track shipments tendered by or for you to UPS for delivery and for no other purpose. Without limitation, you are not authorized to make the Information available on any web site or otherwise reproduce, distribute, copy, store, use or sell the Information for commercial gain without the express written consent of UPS. This is a personal service, thus your right to use the Tracking Systems or Information is non-assignable. Any access or use that is inconsistent with these terms is unauthorized and strictly prohibited.

UPS, UPS brandmark, and the Color Brown are trademarks of United Parcel Service of America, Inc. All Rights Reserved.
<% End Sub Sub AnalyzeTrackXML dim workrecord dim TotalCartcost dim totalcart dim Insurance pos=0 If getupsconfig("xtrace", false, myconn) ="Yes" then Debugwrite Server.HTMLEncode(result) end if Workrecord= Replace(result,"<","~") Workrecord= Replace(workrecord,">","~") Parserecord workrecord, words, Wordcount,"~" 'debugwrite "wordcount=" & wordcount wordloc=0 morewords=TRUE do while morewords=TRUE ProcessupsWord Words(wordloc) wordloc=wordloc+1 If wordloc>=wordcount then morewords=False end if Loop If Statuscode<>"" then Serror=Serror & Statusmessage & "
" end if End Sub Sub Processupsword (fieldname) 'response.write words(wordloc+1) & "
" 'Debugwrite "word=" & Server.HTMLEncode(fieldname) & "" Dim tempoption, tempprice,holdthis Select Case Fieldname Case "ErrorDescription" MoreWords=FALSE Statusmessage=words(wordloc+1) & "
" exit sub Case "ResponseStatusCode" Statuscode=words(wordloc+1) wordloc=wordloc+1 exit sub Case "Number" Statuscode=words(wordloc+1) wordloc=wordloc+1 exit sub Case "ShipTo" shiptoon=true exit sub 'VP-ASP 6.09 - turn shipto off when reaches end of tag Case "/ShipTo" shiptoon=false exit sub Case "Description" if servicestart and statustypeon=false then theservice = words(wordloc+1) servicestart = false end if if activitystart and statustypeon=false then Descriptionact(activitycount)=words(wordloc+1) end if if addresson=true then Addresstype=words(wordloc+1) else if statustypeon=true then statustypearr(activitycount)=words(wordloc+1) end if end if wordloc=wordloc+1 exit sub Case "ShipperNumber" ShipperNumber=words(wordloc+1) wordloc=wordloc+1 exit sub Case "Address" if shiptoon then Address=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "AddressLine1" if shiptoon then AddressLine1=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "AddressLine2" if shiptoon then AddressLine2=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "City" 'VP-ASP 6.09 - add shipto city to its own variable and all the others to an array if shiptoon then shipcity = words(wordloc+1) else Cityarr(activitycount)=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "StateProvinceCode" if shiptoon then StateProvinceCodearr(activitycount)=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "PostalCode" if shiptoon then PostalCode=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "CountryCode" if shiptoon then CountryCodearr(activitycount)=words(wordloc+1) end if wordloc=wordloc+1 exit sub Case "SignedForByName" SignedForByName=words(wordloc+1) wordloc=wordloc+1 exit sub Case "Date" ShipDatearr(activitycount)=words(wordloc+1) wordloc=wordloc+1 exit sub Case "Time" ShipTimearr(activitycount)=words(wordloc+1) wordloc=wordloc+1 exit sub Case "/Activity" activitycount=activitycount+1 exit sub Case "Address" Addresson=true wordloc=wordloc+1 exit sub Case "/Address" Addresson=false wordloc=wordloc+1 exit sub Case "StatusType" statustypeon=true wordloc=wordloc+1 exit sub Case "/StatusType" statustypeon=false wordloc=wordloc+1 exit sub Case "TrackingNumber" Trackingnumber2=words(wordloc+1) wordloc=wordloc+1 Case "Activity" activitystart=true wordloc=wordloc+1 Case "Weight" theweight=words(wordloc+1) wordloc=wordloc+1 Case "Service" servicestart = true wordloc=wordloc+1 Case "UnitOfMeasurement" unitstart = true wordloc=wordloc+1 Case "Code" if unitstart = true then theweightunit = words(wordloc+1) unitstart = false end if End select end sub Function ReturnDate(thedate) dim dd,mm,yy dim i yy=Mid(thedate,1,4) mm=Mid(thedate,5,2) dd=Mid(thedate,7,8) if Mid(mm,1,1)="0" then mm=Replace(mm,"0","") end if Select Case mm Case "1" mm="January" Case "2" mm="February" Case "3" mm="March" Case "4" mm="April" Case "5" mm="May" Case "6" mm="June" Case "7" mm="July" Case "8" mm="August" Case "9" mm="September" Case "10" mm="October" Case "11" mm="November" Case "12" mm="December" End Select ReturnDate=mm & " " & dd & "," & yy End Function Function ReturnTime(theTime) dim thetimeis dim pm,houris,minuteis minuteis=Mid(thetime,3,2) houris=Mid(thetime,1,2) 'if houris>12 then 'houris=houris-12 'pm=" P.M" 'else 'pm=" A.M" 'end if ReturnTime=houris & ":" & minuteis End Function %>