Note: This is not the complete source code--just the main source file.
You can download the full source (with include files) from our sample code archive by clicking on the diskette icons.
<!-- #include file="HexGadgets.inc.vbs.asp" --> <!-- #include file="HexIcmp.inc.vbs.asp" --> <!-- #include file="HexLookup.inc.vbs.asp" --> <!-- #include file="UtilityVars.inc.vbs.asp" --> <% '// Traceroute engine '// version 2002-08-14 '// '// This file defines a class that implements the Traceroute '// engine. Use with Utility.inc.vbs.asp. '// '// Traceroute maps out the path from one host on the Internet '// to another by sending out a series of ICMP echo requests '// with increasing time-to-live settings. The routers along '// the path reveal their addresses when they return TTL-expired '// error messages. '// '// Inputs (form variables): '// - addr (string) Domain or ip address of destination host '// - no_resolve (bool) Don't resolve IP addresses to domain names '// '// HexGadgets (components) required: '// - HexIcmp '// - HexLookup '// Info: http://www.HexGadgets.com/ '// Download: http://www.hexillion.com/download/HexGadgets.exe '// '// Other dependencies: '// - HexGadgets.inc.vbs.asp '// - HexIcmp.inc.vbs.asp '// - HexLookup.inc.vbs.asp '// - UtilityVars.inc.vbs.asp '// - VBScript 5.0 or later '// Get the latest at http://msdn.microsoft.com/scripting/ '// '// History: '// 2002-08-14 Created, based on old AspTrace sample '// '// Copyright 2002 Hexillion Technologies. All rights reserved. '// '// THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY '// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT '// LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND/OR '// FITNESS FOR A PARTICULAR PURPOSE. class Traceroute property Get Name() Name = "Traceroute" end property property Get Desc() Desc = "Trace the path from this server to another" end property property Get ViewSourceURL() ViewSourceURL = "http://www.hexillion.com/samples/view_src.asp?name=Traceroute.inc.vbs.asp" end property property Get DownloadSourceURL() DownloadSourceURL = "http://www.hexillion.com/samples/#Traceroute" end property private m_oIcmp '// HexIcmp object private m_oLkup '// HexLookup object private m_sAddr '// DNS server address private m_bNoResolve '// Don't resolve IP addresses to domain names private m_lLkupErr '// HexLookup license error private m_lIcmpErr '// HexIcmp license error Private Sub Class_Initialize() '// Create objects set m_oLkup = Server.CreateObject( "Hexillion.HexLookup" ) set m_oIcmp = Server.CreateObject( "Hexillion.HexIcmp" ) '// Save license error codes m_lLkupErr = m_oLkup.Error m_lIcmpErr = m_oIcmp.Error end sub Private Sub Class_Terminate() set m_oLkup = nothing set m_oIcmp = nothing end sub Sub WriteForm() '// Check for form input, set defaults m_sAddr = GetVar( m_sAddr, "addr", c_varDomain, null ) m_sAddr = GetVar( m_sAddr, c_varNone, c_varIpAddr, null ) m_sAddr = GetVar( m_sAddr, c_varNone, c_varDerivedDomain, null ) m_sAddr = GetVar( m_sAddr, c_varNone, c_varDerivedIpAddr, request( "REMOTE_HOST" ) ) m_bNoResolve = cbool( GetVar( m_bNoResolve, "no_resolve", c_varNone, false ) ) WriteLn "<form method=""POST"" action=""" & request( "SCRIPT_NAME" ) & """ id=form1>" WriteLn " <table cellpadding=""5"" border=""0"" cellspacing=""0"">" WriteLn " <tr>" WriteLn " <td align=""right"">from</td>" WriteLn " <td width=""2""> </td>" WriteLn " <td><strong>" & request( "SERVER_NAME" ) & " [" & request( "LOCAL_ADDR" ) & "]</strong></td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td align=""right"">to</td>" WriteLn " <td width=""2""> </td>" WriteLn " <td class=""bugfix"">" WriteLn " <input type=""text"" name=""addr"" size=""30"" value=""" & Server.HtmlEncode( m_sAddr ) & """>" WriteLn " </td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" WriteLn " <td width=""2""> </td>" Response.Write " <td valign=""bottom""><input type=""checkbox"" value=""true"" name=""no_resolve""" if m_bNoResolve then Response.Write " checked" WriteLn "> don't resolve IP addresses</td>" WriteLn " <td><input border=""0"" src=""btn_go.gif"" name=""go"" type=""image"" width=""35"" height=""21""></td>" WriteLn " </tr>" WriteLn " </table>" WriteLn "</form>" end sub sub WriteOutput() if "" <> request( "addr" ) then DoTraceroute '// Main work is put off in separate routine '// so "exit sub" statements won't skip the following WriteLicenseWarning "HexIcmp", m_oIcmp, m_lIcmpErr WriteLicenseWarning "HexLookup", m_oLkup, m_lLkupErr end sub private sub DoTraceroute() '// Condition input address m_sAddr = trim( m_sAddr ) '// Try to get an IP address dim lAddr lAddr = m_oLkup.LookUp( m_sAddr ) if 0 = lAddr then WriteLn "<p>Lookup of <span class=""ipaddr"">" & Server.HtmlEncode( m_sAddr ) & "</span> failed.</p>" exit sub end if '// Get ready to set cookie InitCookieVars '// Write input variables to non-persistent cookie '// for use with other utilities and future calls to '// this one '// If the input was an IP address... if m_sAddr = m_oLkup.AddrToString( lAddr ) then SetVar c_varIpAddr, m_sAddr else SetVar c_varDomain, m_sAddr SetVar c_varDerivedIpAddr, lAddr end if WriteLn "<p>Tracing route to <span class=""ipaddr"">" & Server.HtmlEncode( m_sAddr ) & " [" & m_oLkup.AddrToString( lAddr ) & "]</span>...</p>" WriteLn "<table border=""0"" cellspacing=""1"" cellpadding=""3"">" WriteLn " <tr>" WriteLn " <td class=""hdr"" width=""20"" align=""right"" valign=""bottom"">hop</td>" WriteLn " <td class=""hdr"" width=""40"" align=""right"" valign=""bottom"">rtt</td>" WriteLn " <td class=""hdr"" width=""40"" align=""right"" valign=""bottom"">rtt</td>" WriteLn " <td class=""hdr"" width=""40"" align=""right"" valign=""bottom"">rtt</td>" WriteLn " <td class=""hdr"" width=""4"" valign=""bottom""> </td>" WriteLn " <td class=""hdr"" width=""130"" valign=""bottom"">ip address</td>" if not m_bNoResolve then WriteLn " <td class=""hdr"" valign=""bottom"">domain name</td>" end if WriteLn " </tr>" WriteLn "</table>" const maxMissing = 4 '// Max missing hops before aborting trace dim iMissingCount Dim i, j, lRTT, iMax, iErr, bAbort, lRecvAddr dim sRtt(3), sAddr, sFQDN iMax = 30 i = 0 m_oIcmp.Timeout = 1000 bAbort = false Do While lRecvAddr <> lAddr And i < iMax and not bAbort and Response.IsClientConnected i = i + 1 Erase sRtt sAddr = "" sFQDN = "" lRecvAddr = 0 m_oIcmp.SendTtl = i j = 0 Do While j < 3 and not bAbort j = j + 1 lRTT = m_oIcmp.Ping(lAddr) If lRTT < 0 And m_oIcmp.Error <> hexIcmpErrTtlExpiredTransit Then iErr = m_oIcmp.Error Select Case iErr Case hexIcmpErrDestHostUnreachable sRtt( j ) = "Host unreachable" bAbort = True Case hexIcmpErrDestNetUnreachable sRtt( j ) = "Network unreachable" bAbort = True Case hexIcmpErrSourceQuench sRtt( j ) = "SQ" Case hexIcmpErrReqTimedOut sRtt( j ) = "*" Case Else sRtt( j ) = "Err:" & iErr bAbort = True End Select Else lRecvAddr = m_oIcmp.RecvAddr sRtt( j ) = m_oIcmp.RecvRtt End If Loop '// If any of the 3 pings succeeded... If lRecvAddr <> 0 Then '// Print the responding IP address and domain name sAddr = m_oLkup.AddrToString(lRecvAddr) if not m_bNoResolve then sFQDN = m_oLkup.ReverseLookUp(lRecvAddr) end if '// Reset our count of "missing" hops iMissingCount = 0 else '// We have another "missing" hop iMissingCount = iMissingCount + 1 '// Abort if we've had too many consecutive missing if iMissingCount >= maxMissing then bAbort = true End If WriteLn "<table border=""0"" cellspacing=""1"" cellpadding=""3"">" WriteLn " <tr>" WriteLn " <td width=""20"" align=""right"">" & i & "</td>" WriteLn " <td width=""40"" align=""right"">" & sRtt( 1 ) & "</td>" WriteLn " <td width=""40"" align=""right"">" & sRtt( 2 ) & "</td>" WriteLn " <td width=""40"" align=""right"">" & sRtt( 3 ) & "</td>" WriteLn " <td width=""4""> </td>" WriteLn " <td width=""130"">" & sAddr & "</td>" if not m_bNoResolve then WriteLn " <td>" & Server.HtmlEncode( sFQDN ) & "</td>" end if WriteLn " </tr>" WriteLn "</table>" Response.Flush Loop if bAbort then Response.Write "<p>Trace aborted</p>" else Response.Write "<p>Trace complete</p>" end if end sub private sub WriteLn( s ) Response.Write s & vbcrlf end sub end class %>