File: D:/web/homefly/inc/inctracking.asp
<%
'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
sSQL = "SELECT adminZipCode,adminPacking,adminShipping,adminUnits,adminUPSUser,adminUPSpw,adminUPSAccess,countryName,countryCode FROM admin INNER JOIN countries ON admin.adminCountry=countries.countryID"
rs.Open sSQL,cnn,0,1
packtogether = Int(rs("adminPacking"))=1
origZip = rs("adminZipCode")
shipType = Int(rs("adminShipping"))
origCountry = rs("countryName")
origCountryCode = rs("countryCode")
upsUser = upsdecode(rs("adminUPSUser"))
upsPw = upsdecode(rs("adminUPSpw"))
upsAccess = rs("adminUPSAccess")
if Int(rs("adminUnits"))=0 then adminUnits="KGS" else adminUnits="LBS"
rs.Close
%>
<table border="0" cellspacing="0" cellpadding="0" width="<%=maintablewidth%>" bgcolor="#FFFFFF" align="center">
<tr>
<td width="40"><img src="images/LOGO_S.gif"></td><td width="100%" align="center"> <br><font size="4"><strong>UPS Tracking Tool</strong></font><br> </td><td width="40"> </td>
</tr>
</table>
<%
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 & "<BR>"
if addressline2<>"" then theAddress = theAddress & addressline2 & "<BR>"
if addressline3<>"" then theAddress = theAddress & addressline3 & "<BR>"
if city<>"" then theAddress = theAddress & city & "<BR>"
if statecode<>"" AND postcode<>"" then
theAddress = theAddress & statecode & ", " & postcode & "<BR>"
else
if statecode<>"" then theAddress = theAddress & statecode & "<BR>"
if postcode<>"" then theAddress = theAddress & postcode & "<BR>"
end if
if countrycode<>"" then theAddress = theAddress & countrycode & "<BR>"
End Function
Function ParseUPSTrackingOutput(sXML, byRef totActivity, byRef shipperNo, byRef serviceDesc, byRef shipperaddress, byRef shiptoaddress, 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.<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="Shipment" then
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
' response.write "Nodename is : " & e.nodeName & "<BR>"
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 "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 & "<BR>"
end if
Next
Case "Package"
For k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
if 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 "<HR>"
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 = "<?xml version=""1.0""?><AccessRequest xml:lang=""en-US""><AccessLicenseNumber>"&upsAccess&"</AccessLicenseNumber><UserId>"&upsUser&"</UserId><Password>"&upsPw&"</Password></AccessRequest>"
sXML = sXML & "<?xml version=""1.0""?><TrackRequest xml:lang=""en-US""><Request><TransactionReference><CustomerContext>Example 3</CustomerContext><XpciVersion>1.0001</XpciVersion></TransactionReference><RequestAction>Track</RequestAction><RequestOption>"
if Trim(request.form("activity"))="LAST" then sXML = sXML & "none" else sXML = sXML & "activity"
sXML = sXML & "</RequestOption></Request>"
if false then
sXML = sXML & "<ReferenceNumber><Value>"&trackNo&"</Value></ReferenceNumber>"
sXML = sXML & "<ShipperNumber>116593</ShipperNumber></TrackRequest>"
else
sXML = sXML & "<TrackingNumber>"&trackNo&"</TrackingNumber></TrackRequest>"
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,"</","</"),"<","<br><")&"<HR>"
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,"</","</"),"<","<br><")&"<HR>"
success = ParseUPSTrackingOutput(objHttp.responseText, totActivity, shipperNo, serviceDesc, shipperaddress, shiptoaddress, 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
%>
<table border="0" cellspacing="0" cellpadding="0" width="<%=maintablewidth%>" bgcolor="#B1B1B1" align="center">
<tr>
<td width="100%">
<table width="100%" border="0" bordercolor="#B1B1B1" cellspacing="1" cellpadding="3" bgcolor="#B1B1B1">
<% if Trim(shipperNo)<>"" then %>
<tr>
<td bgcolor="#EBEBEB" width="30%"><strong>Shipper Number</strong> </td>
<td bgcolor="#FFFFFF"><%=shipperNo%></td>
</tr>
<% end if
if Trim(serviceDesc)<>"" then %>
<tr>
<td bgcolor="#EBEBEB" width="30%"><strong>Service Description</strong> </td>
<td bgcolor="#FFFFFF"><%=serviceDesc%></td>
</tr>
<% end if
if Trim(shipperaddress)<>"" then %>
<tr>
<td bgcolor="#EBEBEB" width="30%" valign="top"><strong>Shipper Address</strong> </td>
<td bgcolor="#FFFFFF"><%=shipperaddress%></td>
</tr>
<% end if
if Trim(shiptoaddress)<>"" then %>
<tr>
<td bgcolor="#EBEBEB" width="30%" valign="top"><strong>Ship-To Address</strong> </td>
<td bgcolor="#FFFFFF"><%=shiptoaddress%></td>
</tr>
<% end if %>
</table>
</td>
</tr>
</table>
<table border="0" cellspacing="0" cellpadding="0" width="<%=maintablewidth%>" bgcolor="#B1B1B1" align="center">
<tr>
<td width="100%">
<table width="100%" border="0" bordercolor="#B1B1B1" cellspacing="1" cellpadding="3" bgcolor="#B1B1B1">
<tr>
<td valign="top" bgcolor="#CCCCCC"><strong>Location</strong></td>
<td valign="top" bgcolor="#CCCCCC"><strong>Description</strong></td>
<td valign="top" bgcolor="#CCCCCC"><strong>Date / Time</strong></td>
</tr>
<% for index=0 to totActivity-1
if cellbg="#EBEBEB" then
cellbg="#FFFFFF"
else
cellbg="#EBEBEB"
end if
%>
<tr>
<td valign="top" bgcolor="<%=cellbg%>"><font size="1"><% if lastloc=activityList(index,0) then
response.write "<p align='center'>""</p>"
else
response.write activityList(index,0)
lastloc = activityList(index,0)
end if %></font></td>
<td valign="top" bgcolor="<%=cellbg%>"><font size="1"><% response.write activityList(index,4)
if activityList(index,1)<>"" then response.write "<br><strong>Signed By :</strong> " & activityList(index,1) %></font></td>
<td valign="top" bgcolor="<%=cellbg%>"><font size="1"><%=DateSerial(Left(activityList(index,6),4),Mid(activityList(index,6),5,2),Mid(activityList(index,6),7,2))%></font><br>
<font size="1"><%=TimeSerial(Left(activityList(index,7),2),Mid(activityList(index,7),3,2),Mid(activityList(index,7),5,2))%></font></td>
</tr>
<% next %>
</table>
</td>
</tr>
</table>
<hr width="70%">
<%
else
%>
<table border="0" cellspacing="<%=maintablespacing%>" cellpadding="<%=maintablepadding%>" width="<%=maintablewidth%>" bgcolor="<%=maintablebg%>" align="center">
<tr>
<td width="100%">
<table width="<%=innertablewidth%>" border="0" cellspacing="<%=innertablespacing%>" cellpadding="<%=innertablepadding%>" bgcolor="<%=innertablebg%>">
<tr>
<td colspan="4" width="50%" align="right">UPS Tracking returned the following error : </td>
<td colspan="4" width="50%"><%=errormsg%></td>
</tr>
</table>
</td>
</tr>
</table>
<hr width="70%">
<%
end if
End If
UPSTrack = success
set objHttp = nothing
end function
if Trim(Request.Form("trackno"))<>"" then
UPSTrack(Trim(Request.Form("trackno")))
end if
%>
<script language="JavaScript">
<!--
function viewlicense()
{
var prnttext = '<html><head><STYLE TYPE="text/css">A:link {COLOR: #333333; TEXT-DECORATION: none}A:visited {COLOR: #333333; TEXT-DECORATION: none}A:active {COLOR: #333333; TEXT-DECORATION: none}A:hover {COLOR: #f39000; TEXT-DECORATION: none}TD {FONT-FAMILY: Verdana;}P {FONT-FAMILY: Verdana;}HR {color: #637BAD;height: 1px;}</STYLE></head><body><table width="100%" border="0" cellspacing="1" cellpadding="3">\n';
prnttext += '<tr><td colspan="2" align="center"><a href="javascript:window.close()"><strong>Close Window</strong></a></td></tr>';
prnttext += '<tr><td width="40"><img src="images/LOGO_S.gif"></td><td><p><font size="3" face="Verdana"><strong>UPS Tracking Terms and Conditions</strong></font></p></td></tr>';
prnttext += '<tr><td colspan="2"><p><font size="2" face="Verdana">The UPS package tracking systems accessed via this Web Site (the "Tracking Systems") and tracking information obtained through this Web Site (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.</font></p></td></tr>';
prnttext += '<tr><td colspan="2"><hr><font size="1" face="Verdana">Copyright © 1994-2003 United Parcel Service of America, Inc. All rights reserved.</font></td></tr>';
prnttext += '<tr><td colspan="2" align="center"> <br><a href="javascript:window.close()"><strong>Close Window</strong></a></td></tr>';
prnttext += '</table></body></html>';
var newwin = window.open("","viewlicense",'menubar=no, scrollbars=yes, width=500, height=400, directories=no,location=no,resizable=yes,status=no,toolbar=no');
newwin.document.open();
newwin.document.write(prnttext);
newwin.document.close();
}
function checkaccept()
{
if (document.trackform.agreeconds.checked == false)
{
alert("Please note: To track your package(s), you must accept the UPS Tracking Terms and Conditions by selecting the checkbox below.");
return (false);
}else{
document.trackform.submit();
}
return (true);
}
//-->
</script>
<table border="0" cellspacing="0" cellpadding="0" width="<%=maintablewidth%>" bgcolor="#B1B1B1" align="center">
<tr>
<td width="100%">
<table width="100%" border="0" bordercolor="#B1B1B1" cellspacing="1" cellpadding="3" bgcolor="#B1B1B1">
<form method="post" name="trackform" action="tracking.asp">
<tr>
<td width="50%" bgcolor="#EBEBEB" align="right">Please enter your UPS Tracking Number : </td>
<td width="50%" bgcolor="#FFFFFF"><input type="text" size="<%=atb(30)%>" name="trackno" value="<%=Trim(Request.Form("trackno"))%>"></td>
</tr>
<tr>
<td width="50%" bgcolor="#EBEBEB" align="right">Show Activity : </td>
<td width="50%" bgcolor="#FFFFFF"><select name="activity" size="1"><option value="LAST">Show Last Activity Only</option><option value="ALL"<% if Trim(Request.Form("activity")="ALL") then response.write " selected"%>>Show All Activity</option></select></td>
</tr>
<tr>
<td bgcolor="#FFFFFF" colspan="2"><table width="100%" cellspacing="0" cellpadding="0" border="0">
<tr>
<td bgcolor="#FFFFFF" width="17%" height="26"> </td>
<td bgcolor="#FFFFFF" width="66%" align="center"><input type="button" onClick="viewlicense()" value="View License"> <input type="button" value="Track Package" onClick="checkaccept()"></td>
<td bgcolor="#FFFFFF" width="17%" height="26" align="right" valign="bottom"><img src="images/tablebr.gif"></td>
</tr>
</table></td>
</tr>
<tr>
<td width="100%" bgcolor="#FFFFFF" height="30" colspan="2" align="center" valign="middle"><font size="1"><input type="checkbox" name="agreeconds" value="ON" <%if request.form("agreeconds")="ON" then response.write "checked"%>> By selecting this box and the "Track Package" button, I agree to these <a href="javascript:viewlicense();"><strong>Terms and Conditions</strong></a>.</font></td>
</tr>
</form>
</table>
</td>
</tr>
</table>
<table border="0" cellspacing="0" cellpadding="0" width="100%" bgcolor="#FFFFFF" align="center">
<tr>
<td width="100%" align="center"><p> <br><font size="1">UPS®, UPS & Shield Design® and UNITED PARCEL SERVICE®
are<br>registered trademarks of United Parcel Service of America, Inc.</font></p></td>
</tr>
</table>