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" --> <% '// Ping engine '// version 2004-08-20 '// '// This file defines a class that implements the Ping '// engine. Use with Utility.inc.vbs.asp. '// '// Ping is a simple network diagnostic utility that can '// check to see if a host is reachable or look for packet '// loss along the network path. '// '// Inputs (form variables): '// - addr (string) Domain or ip address to ping '// - count (int) Number of packets to send '// - size (long) Size of packets to send (bytes) '// - ttl (int) Time-to-live setting for outgoing packets (hops) '// - timeout (long) Time to wait for a reply (ms) '// - no_frag (bool) Don't allow fragmentation of packets '// '// 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: '// 2004-08-20 Limited packet size to prevent use for DoS attacks '// 2002-08-14 Created '// '// 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 Ping property Get Name() Name = "Ping" end property property Get Desc() Desc = "See if a host is reachable" end property property Get ViewSourceURL() ViewSourceURL = "http://www.hexillion.com/samples/view_src.asp?name=Ping.inc.vbs.asp" end property property Get DownloadSourceURL() DownloadSourceURL = "http://www.hexillion.com/samples/#Ping" end property private m_oIcmp '// HexIcmp object private m_oLkup '// HexLookup object private m_sAddr '// DNS server address private m_iCount '// Number of packets to send private m_lSize '// Size of packets to send private m_iTtl '// TTL setting in outgoing packets private m_lTimeout '// Time to wait for each packet private m_bNoFrag '// Disallow fragmentation 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_iCount = cint( GetVar( m_iCount, "count", c_varPingCount, 5 ) ) m_lSize = clng( GetVar( m_lSize, "size", c_varPingSize, 32 ) ) m_iTtl = cint( GetVar( m_iTtl, "ttl", c_varPingTtl, m_oIcmp.SendTtl ) ) m_lTimeout = clng( GetVar( m_lTimeout, "timeout", c_varPingTimeout, m_oIcmp.Timeout ) ) m_bNoFrag = cbool( GetVar( m_bNoFrag, "no_frag", c_varNone, false ) ) WriteLn "<form method=""POST"" action=""" & request( "SCRIPT_NAME" ) & """ id=form1>" WriteLn " <table cellpadding=""5"" border=""0"" cellspacing=""0"" width=""100%"">" WriteLn " <tr>" WriteLn " <td align=""right"">domain or IP address</td>" WriteLn " <td class=""bugfix"" colspan=""3"">" WriteLn " <input type=""text"" name=""addr"" size=""30"" value=""" & Server.HtmlEncode( m_sAddr ) & """> " WriteLn " </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td align=""right"">packets to send</td>" WriteLn " <td class=""bugfix"">" WriteLn " <input type=""text"" name=""count"" size=""7"" value=""" & Server.HtmlEncode( m_iCount ) & """>" WriteLn " </td>" WriteLn " <td align=""right"">timeout (ms)</td>" WriteLn " <td class=""bugfix"">" WriteLn " <input type=""text"" name=""timeout"" size=""7"" value=""" & Server.HtmlEncode( m_lTimeout ) & """>" WriteLn " </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td align=""right"">data size (bytes)</td>" WriteLn " <td class=""bugfix"">" WriteLn " <input type=""text"" name=""size"" size=""7"" value=""" & Server.HtmlEncode( m_lSize ) & """>" WriteLn " </td>" WriteLn " <td align=""right"">ttl (hops)</td>" WriteLn " <td class=""bugfix"">" WriteLn " <input type=""text"" name=""ttl"" size=""7"" value=""" & Server.HtmlEncode( m_iTtl ) & """>" WriteLn " </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" Response.Write "<td valign=""bottom"" colspan=""2""><input type=""checkbox"" value=""true"" name=""no_frag""" if m_bNoFrag then Response.Write " checked" WriteLn "> don't fragment</td>" WriteLn " <td><input border=""0"" src=""btn_go.gif"" name=""go"" type=""image"" width=""35"" height=""21"" hspace=""20""></td>" WriteLn " </tr>" WriteLn " </table>" WriteLn "</form>" end sub sub WriteOutput() if "" <> request( "addr" ) then DoPing '// 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 DoPing() '// Check timeout if m_lTimeout < 0 or m_lTimeout > 30000 then WriteLn "<p>Timeout must be from 1 to 30000.</p>" exit sub end if '// Check count if m_iCount < 0 or m_iCount > 30 then WriteLn "<p>Number of packets must be from 1 to 30.</p>" exit sub end if '// Check count combined with timeout dim iWorstCaseTime iWorstCaseTime = m_lTimeout * m_iCount if iWorstCaseTime > 30000 then WriteLn "<p>(Number of packets * Timeout) must be less than 30000.</p>" exit sub end if '// Check send size '// MS ping send size is payload data only (does not include IP header or ICMP header) '// Unix ping send size is ICMP header and payload (does not include IP header) '// HexIcmp.SendSize is IP header (20 bytes) + ICMP header (8 bytes) + payload '// '// To avoid additional confusion, this utility will adopt the MS ping definition of size. '// Max size is normally 65507, but limit it here to prevent users '// from using this utility to launch effective denial-of-service attacks. if m_lSize < 0 or m_lSize > 100 then WriteLn "<p>Data size must be from 0 to 100.</p>" exit sub end if '// Check ttl if m_iTtl < 1 or m_iTtl > 255 then WriteLn "<p>TTL must be from 1 to 255.</p>" exit sub end if '// 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 SetVar c_varPingCount, m_iCount SetVar c_varPingSize, m_lSize SetVar c_varPingTtl, m_iTtl SetVar c_varPingTimeout, m_lTimeout WriteLn "<p>Pinging <span class=""ipaddr"">" & Server.HtmlEncode( m_sAddr ) & _ " [" & m_oLkup.AddrToString( lAddr ) & "]</span> " & _ "with " & m_lSize & " bytes of data...</p>" WriteLn "<h3>Results</h3>" WriteLn "<table border=""0"" cellspacing=""1"" cellpadding=""3"">" WriteLn " <tr>" WriteLn " <td class=""hdr"" width=""50"" align=""right"" valign=""top"">count</td>" WriteLn " <td class=""hdr"" width=""50"" align=""right"" valign=""top"">ttl (hops)</td>" WriteLn " <td class=""hdr"" width=""50"" align=""right"" valign=""top"">rtt (ms)</td>" WriteLn " <td class=""hdr"" width=""4"" align=""right"" valign=""top""> </td>" WriteLn " <td class=""hdr"" width=""100"" align=""left"" valign=""top"">from</td>" WriteLn " <td width=""4""> </td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn "</table>" '// Send what we have so far to browser Response.Flush '// Set up the ping parameters m_oIcmp.SendSize = m_lSize + 28 '// Convert from payload size to total IP packet size m_oIcmp.SendTtl = m_iTtl m_oIcmp.SendAllowFrag = not m_bNoFrag m_oIcmp.Timeout = m_lTimeout dim i, iReceived, iLost, lRttMin, lRttMax, lRttSum, lRtt iReceived = 0 lRttMin = m_lTimeout lRttMax = 0 lRttSum = 0 '// Do the pinging for i = 1 to m_iCount if not Response.IsClientConnected then exit sub WriteLn "<table border=""0"" cellspacing=""1"" cellpadding=""3"">" WriteLn " <tr>" WriteLn " <td width=""50"" align=""right"" valign=""bottom"">" & i & "</td>" lRtt = m_oIcmp.Ping( lAddr ) '// If there was an error... if lRtt < 0 then '// Leave the numeric fields blank WriteLn " <td width=""50""> </td>" WriteLn " <td width=""50""> </td>" WriteLn " <td width=""4""> </td>" '// Only display the IP address for cases in which '// the error might have come from the address select case m_oIcmp.Error case hexIcmpErrDestNetUnreachable, _ hexIcmpErrDestHostUnreachable, _ hexIcmpErrDestProtUnreachable, _ hexIcmpErrDestPortUnreachable, _ hexIcmpErrPacketTooBig, _ hexIcmpErrTtlExpiredTransit, _ hexIcmpErrTtlExpiredReassm, _ hexIcmpErrParamProblem, _ hexIcmpErrSourceQuench WriteLn " <td width=""100"">" & m_oLkup.AddrToString( m_oIcmp.RecvAddr ) & "</td>" case else WriteLn " <td width=""100""> </td>" end select '// Write the error message WriteLn " <td width=""4""> </td>" WriteLn " <td valign=""top"">" & Server.HtmlEncode( GetIcmpErrorString( m_oIcmp.Error ) ) & "</td>" else '// We got a successful reply '// Update the stats iReceived = iReceived + 1 if lRtt > lRttMax then lRttMax = lRtt if lRtt < lRttMin then lRttMin = lRtt lRttSum = lRttSum + lRtt '// Display the results WriteLn " <td width=""50"" align=""right"" valign=""bottom"">" & m_oIcmp.RecvTtl & "</td>" WriteLn " <td width=""50"" align=""right"" valign=""bottom"">" & lRtt & "</td>" WriteLn " <td width=""4""> </td>" WriteLn " <td width=""100"">" & m_oLkup.AddrToString( m_oIcmp.RecvAddr ) & "</td>" WriteLn " <td width=""4""> </td>" WriteLn " <td> </td>" end if WriteLn " </tr>" WriteLn "</table>" Response.Flush next iLost = m_iCount - iReceived dim sRttMin, sRttAvg, sRttMax if iReceived > 0 then sRttMin = lRttMin sRttAvg = cint( lRttSum / iReceived ) sRttMax = lRttMax else sRttMin = "-" sRttAvg = "-" sRttMax = "-" end if '// Display the stats WriteLn "<h3>Statistics</h3>" WriteLn "<table border=""0"" cellspacing=""1"" cellpadding=""4"">" WriteLn " <tr>" WriteLn " <td class=""hdr"" align=""right"" valign=""top"">packets</td>" WriteLn " <td>sent</td>" WriteLn " <td align=""right"">" & m_iCount & "</td>" WriteLn " <td width=""40""> </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" WriteLn " <td>received</td>" WriteLn " <td align=""right"">" & iReceived & "</td>" WriteLn " <td width=""40"" align=""right"">" & cint( iReceived / m_iCount * 100 ) & "%</td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" WriteLn " <td>lost</td>" WriteLn " <td align=""right"">" & iLost & "</td>" WriteLn " <td width=""40"" align=""right"">" & cint( iLost / m_iCount * 100 ) & "%</td>" WriteLn " </tr>" WriteLn " <tr height=""20""></tr>" WriteLn " <tr>" WriteLn " <td class=""hdr"" align=""right"" valign=""top"">times (ms)</td>" WriteLn " <td>min</td>" WriteLn " <td align=""right"">" & sRttMin & "</td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" WriteLn " <td>avg</td>" WriteLn " <td align=""right"">" & sRttAvg & "</td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" WriteLn " <td>max</td>" WriteLn " <td align=""right"">" & sRttMax & "</td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn "</table>" end sub private sub WriteLn( s ) Response.Write s & vbcrlf end sub end class %>