asked on

Ping result missing some failures

I have written a very small ping wild card application that will search an entire range of ip's, i.e. 192.168.0.x so it will ping from 192.168.0.0 to 192.168.0.254 and tell me whether it is getting a response or not and hen if it does it does a reverse dns lookup.

My problem is that the result is sometimes incorrect for a specific scenario.
I only thought I would expect a pass or fail but it seems that is counts a TTL expired in transit response as a pass, obviously because of the simple method I am using, or a return value I dont know to check.

Below is a copy of the unit of code I am using, and I just call ping( 192.168.0.0)
The result obviously comes from result := ( DW <> 0);
Is there anything else I can check?

As for some more information
A valid ping response looks like this

Pinging 192.168.0.0 with 32 bytes of data:

Reply from 192.168.0.0: bytes=32 time=6ms TTL=255
Reply from 192.168.0.0: bytes=32 time=1ms TTL=255
Reply from 192.168.0.0: bytes=32 time=4ms TTL=255
Reply from 192.168.0.0: bytes=32 time=1ms TTL=255

Ping statistics for 192.168.0.0:
Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),
Approximate round trip times in milli-seconds:
Minimum = 1ms, Maximum = 6ms, Average = 3ms

and an invalid one looks might look like this:

Pinging 192.168.0.1 with 32 bytes of data:

Request timed out.
Request timed out.
Request timed out.
Request timed out.

Ping statistics for 192.168.0.1:
Packets: Sent = 4, Received = 0, Lost = 4 (100% loss),

or look like this

Pinging 192.168.0.2 with 32 bytes of data:

Reply from 192.168.0.2: TTL expired in transit.
Reply from 192.168.0.2: TTL expired in transit.
Reply from 192.168.0.2: TTL expired in transit.
Reply from 192.168.0.2: TTL expired in transit.

Ping statistics for 192.168.0.2:
Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),
Approximate round trip times in milli-seconds:
Minimum = 0ms, Maximum = 0ms, Average = 0ms

unit raw_ping;
 
interface
 
uses
   Windows, SysUtils, Classes;
 
type
   TSunB = packed record
      s_b1, s_b2, s_b3, s_b4: byte;
   end;
 
   TSunW = packed record
      s_w1, s_w2: word;
   end;
 
   PIPAddr = ^TIPAddr;
   TIPAddr = record
      case integer of
         0: (S_un_b: TSunB);
         1: (S_un_w: TSunW);
         2: (S_addr: longword);
      end;
 
 IPAddr = TIPAddr;
 
function IcmpCreateFile: THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle( icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll'
function IcmpSendEcho( IcmpHandle : THandle; DestinationAddress : IPAddr;
                       RequestData : Pointer; RequestSize : Smallint;
                       RequestOptions : pointer;
                       ReplyBuffer : Pointer;
                       ReplySize : DWORD;
                       Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';
 
 
function Ping(InetAddress : string) : boolean;
 
procedure TranslateStringToTInAddr( AIP: string; var AInAddr);
 
implementation
 
uses
   WinSock;
 
function Fetch( var AInput: string; const ADelim: string = ' ';
                const ADelete: Boolean = true): string;
var
  iPos: Integer;
begin
   if ADelim = #0 then
   begin
      // AnsiPos does not work with #0
      iPos := Pos(ADelim, AInput);
   end else
      begin
         iPos := Pos(ADelim, AInput);
      end;
 
   if iPos = 0 then
   begin
      Result := AInput;
 
      if ADelete then
      begin
         AInput := '';
      end;
   end else
      begin
         result := Copy(AInput, 1, iPos - 1);
         if ADelete then
         begin
            Delete(AInput, 1, iPos + Length(ADelim) - 1);
         end;
      end;
end;
 
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
   phe: PHostEnt;
   pac: PChar;
   GInitData: TWSAData;
begin
   WSAStartup($101, GInitData);
   try
      phe := GetHostByName(PChar(AIP));
      if Assigned(phe) then
      begin
         pac := phe^.h_addr_list^;
         if Assigned(pac) then
         begin
            with TIPAddr(AInAddr).S_un_b do
            begin
               s_b1 := Byte(pac[0]);
               s_b2 := Byte(pac[1]);
               s_b3 := Byte(pac[2]);
               s_b4 := Byte(pac[3]);
            end;
         end else
            begin
               raise Exception.Create('Error getting IP from HostName');
            end;
      end else
         begin
            raise Exception.Create('Error getting HostName');
         end;
   except
      FillChar(AInAddr, SizeOf(AInAddr), #0);
   end;
   WSACleanup;
end;
 
function Ping( InetAddress : string) : boolean;
var
   handle: THandle;
   inAddr: IPAddr;
   DW: DWORD;
   rep: array[ 1..128] of byte;
begin
   result := false;
   handle := IcmpCreateFile;
   if handle = INVALID_HANDLE_VALUE then
      exit;
 
   translateStringToTInAddr( inetAddress, inAddr);
   DW := icmpSendEcho( handle, inAddr, nil, 0, nil, @rep, 128, 0);
   result := ( DW <> 0);
   icmpCloseHandle(Handle);
end;
 
end.

Open in new window

Geert G

I got this too in a small application to check network failures.
The app pinged several servers. 1 thread for each server (or ip address)
In the end I got this code (extract) using Indy TIdIcmpClient

FIFOPush is just a stacked log routine

procedure TPingThread.Execute;
var Log: string;
  n: integer;
begin
  FStarted := Now;
  FLastSuccess := FStarted;
  FLastFailed := FStarted;
  Log := FHost + '||' + FIP + '||' + IntToStr(FSequence) + '||' + DateTimeToStr(FStarted, FFM);
  if not FSingleTest then
    FIFOPush(idStart, Log);
  repeat
    if FInterVal > 0 then
      sleep(FInterval);
    try
      repeat
        n := FIFOCount;
        (*
        if n >= 100 then
        begin
          //FIFOPush(idRestart, FHOST + '||' + FIP);
          //StopPing(FHost, Self);
          Terminate;
        end;
        *)
        if n >= MaxMessagesQueue then Sleep(2000);
      until (n < MaxMessagesQueue) or Terminated;
      if not Terminated then
      begin
        FPing.Ping(FormatDateTime('dd-mm-yyyy hh:nn:ss.ssss', FSequence);
        Sleep(FTimeOut + 50);
      end;
    except
      on E: Exception do
      begin
        if not FInFail then
        begin
          FLastFailed := Now;
          FInFail := True;
          FIFOPush(idLostConnection, FHost + '||' + FIP + '||' + IntToStr(FSequence) + '||' + DateTimeToStr(FLastFailed, FFM));
          Inc(FTotalFails);
        end else
        begin
          if not FSingleTest then
            FIFOPush(idLostConnectionNext, FHost + '||' + FIP + '||' + IntToStr(FSequence) + '||' + DateTimeToStr(FLastFailed, FFM))
          else
            FIFOPush(idPing, FHost + '||not found');
        end;
      end;
    end;
    FFirst := False;
  until Terminated or FSingleTest;
  if not FSingleTest and not Terminated then
    FIFOPush(idEnd, FHost + '||' + FIP + '||' + IntToStr(FSequence) + '||' + DateTimeToStr(Now, FFM));
end;
 
procedure TPingThread.PingReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
var Temp: string;
begin
  if AReplyStatus.BytesReceived <= 0 then
  begin // Failed
    if not FInFail then
    begin
      FLastFailed := Now;
      FInFail := True;
      if not FSingleTest then
        FIFOPush(idLostConnection, FHost + '||' + AReplyStatus.FromIpAddress + '||' + DateTimeToStr(FLastFailed, FFM) + '||' + IntToStr(AReplyStatus.SequenceId))
      else
        FIFOPush(idPing, FHost + '||not found');
      Inc(FTotalFails);
    end;
  end else
  begin // success
    if AReplyStatus.FromIpAddress = FIP then
    begin
      FLastSuccess := Now;
      if FInFail then
      begin
        FFailedSeconds := SecondsBetween(FLastSuccess, FLastFailed);
        if not FFirst then
        begin
          if not FSingleTest then
            FIFOPush(idReconnected, FHost + '||' + AReplyStatus.FromIpAddress + '||' + DateTimeToStr(FLastSuccess, FFM) + '||' + IntToStr(FFailedSeconds) + '||' + IntToStr(FTotalFails) + IntToStr(AReplyStatus.SequenceId));
        end;
        FInFail := False;
        if FSingleTest then
          FIFOPush(idPing, FHost + '||' + AReplyStatus.FromIpAddress);
      end;
    end
      else FIFOPush(idStrayMessage, FHOST + '||' + AReplyStatus.FromIpAddress);
  end;
  if not FSingleTest then
  begin
    Temp := '';
    case AReplyStatus.ReplyStatusType of
      rsEcho: Temp := 'Echo';
      rsError: Temp := 'Error';
      rsTimeOut: Temp := 'TimeOut';
      rsErrorUnreachable: Temp := 'Unreachable';
      rsErrorTTLExceeded: Temp := 'TTLExceeded';
    end;
    with AReplyStatus do
      FIFOPush(idPingMessage, FHost + '||' + FromIpAddress + '||' + Format('IPAddress: %s; BytesReceived: %d; TimeToLive: %d; RoundTripTime: %d; Status: %s',
        [FromIpAddress, BytesReceived, TimeToLive, MsRoundTripTime, Temp]));
  end;
end;

Open in new window

Mike Littlewood

ASKER

I'm wondering if in your code

case AReplyStatus.ReplyStatusType of
rsEcho: Temp := 'Echo';
rsError: Temp := 'Error';
rsTimeOut: Temp := 'TimeOut';
rsErrorUnreachable: Temp := 'Unreachable';
rsErrorTTLExceeded: Temp := 'TTLExceeded';
end;

is similar to the result from in mine

DW := icmpSendEcho( handle, inAddr, nil, 0, nil, @rep, 128, 0);

Do you have the declaration section for your thread object?

Mike Littlewood

ASKER

I've tried a slightly different method using the TIdIcmpClient object from Indy.

IdIcmpClient1.ReceiveTimeout := 25;
IdIcmpClient1.Host := '192.168.0.1';
IdIcmpClient1.Ping;

As soon as I call ping though it throws an error
*************************
Socket Error # 10049
Cannot assign requested address
*************************
All I can assume is that it might be because the port number is set to 0, though if it needs to be something else, I have no idea what value is required.

SOLUTION

Geert G

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Geert G

basically you can ping on any port
ping 21 : check if FTP port is open
ping 80 : check if HTTP port is open

Russell Libby

Below is the source for my IcmpUtils unit, and Ping is one of the functions exposed from it. It can take the address in DNS or dotted format, and allows you to pass a timeout value to it. If you pass zero, it will use its default of 5000 ms. As to the response from IcmpEcho, if it succeeded, that does not mean the ping went through. You need to check the Reply's (TICMPEchoReply) status field to ensure its IP_SUCCESS (0), and not one of the following:

IP_STATUS_BASE = 11000;
IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1);
IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2);
IP_DEST_HOST_UNREACHABLE= (IP_STATUS_BASE + 3);
IP_DEST_PROT_UNREACHABLE= (IP_STATUS_BASE + 4);
IP_DEST_PORT_UNREACHABLE= (IP_STATUS_BASE + 5);
IP_NO_RESOURCES = (IP_STATUS_BASE + 6);
IP_BAD_OPTION = (IP_STATUS_BASE + 7);
IP_HW_ERROR = (IP_STATUS_BASE + 8);
IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9);
IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10);
IP_BAD_REQ = (IP_STATUS_BASE + 11);
IP_BAD_ROUTE = (IP_STATUS_BASE + 12);
IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13);
IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14);
IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15);
IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16);
IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17);
IP_BAD_DESTINATION = (IP_STATUS_BASE + 18);

Hope this helps,
Russell

----

unit IcmpUtils;
////////////////////////////////////////////////////////////////////////////////
//
// Unit : IcmpUtils
// Author : rllibby
// Date : 07.18.2006
// Description : Set of ICMP utility routines based off the iphlpapi library
// in Windows. Exposes the following:
//
// - Ability to get inbound / outbound ICMP statistics
// - Ping
// - TraceRoute
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
// Include units
////////////////////////////////////////////////////////////////////////////////
uses
Windows, SysUtils, Classes, WinSock;

///////////////////////////////////////////////////////////////////////////////
// ICMP library constants
////////////////////////////////////////////////////////////////////////////////
const
IPHLPAPI_LIBRARY = 'iphlpapi.dll';

/////////////////////////////////////////////////
// This can optionally be set to use the icmp.dll
/////////////////////////////////////////////////
ICMP_LIBRARY = IPHLPAPI_LIBRARY;

////////////////////////////////////////////////////////////////////////////////
// ICMP error constants
////////////////////////////////////////////////////////////////////////////////
const
IP_SUCCESS = ERROR_SUCCESS;
IP_STATUS_BASE = 11000;
IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1);
IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2);
IP_DEST_HOST_UNREACHABLE= (IP_STATUS_BASE + 3);
IP_DEST_PROT_UNREACHABLE= (IP_STATUS_BASE + 4);
IP_DEST_PORT_UNREACHABLE= (IP_STATUS_BASE + 5);
IP_NO_RESOURCES = (IP_STATUS_BASE + 6);
IP_BAD_OPTION = (IP_STATUS_BASE + 7);
IP_HW_ERROR = (IP_STATUS_BASE + 8);
IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9);
IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10);
IP_BAD_REQ = (IP_STATUS_BASE + 11);
IP_BAD_ROUTE = (IP_STATUS_BASE + 12);
IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13);
IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14);
IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15);
IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16);
IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17);
IP_BAD_DESTINATION = (IP_STATUS_BASE + 18);

////////////////////////////////////////////////////////////////////////////////
// ICMP option types
////////////////////////////////////////////////////////////////////////////////
const
IP_OPT_EOL = $00; // End of list option
IP_OPT_NOP = $01; // No operation
IP_OPT_SECURITY = $82; // Security option.
IP_OPT_LSRR = $83; // Loose source route.
IP_OPT_SSRR = $89; // Strict source route.
IP_OPT_RR = $07; // Record route.
IP_OPT_TS = $44; // Timestamp.
IP_OPT_SID = $88; // Stream ID (obsolete)

const
MAX_OPT_SIZE = 40;

////////////////////////////////////////////////////////////////////////////////
// ICMP structures
////////////////////////////////////////////////////////////////////////////////
type
ICMP_OPTION_INFORMATION = packed record
Ttl: u_char;
Tos: u_char;
Flags: u_char;
OptionsSize: u_char;
OptionsData: Pointer;
end;
PICMP_OPTION_INFORMATION= ^ICMP_OPTION_INFORMATION;
TICMPOptionInformation = ICMP_OPTION_INFORMATION;
PICMPOptionInformation = ^TICMPOptionInformation;

type
ICMP_ECHO_REPLY = packed record
Address: u_long;
Status: u_long;
RTTime: u_long;
DataSize: u_short;
Reserved: u_short;
Data: Pointer;
Options: TICMPOptionInformation;
end;
PICMPP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
TICMPEchoReply = ICMP_ECHO_REPLY;
PICMPEchoReply = ^TICMPEchoReply;

////////////////////////////////////////////////////////////////////////////////
// ICMP statistics structures
////////////////////////////////////////////////////////////////////////////////
type
MIBICMPSTATS = packed record
dwMsgs: DWORD; // number of messages
dwErrors: DWORD; // number of errors
dwDestUnreachs: DWORD; // destination unreachable messages
dwTimeExcds: DWORD; // time-to-live exceeded messages
dwParmProbs: DWORD; // parameter problem messages
dwSrcQuenchs: DWORD; // source quench messages
dwRedirects: DWORD; // redirection messages
dwEchos: DWORD; // echo requests
dwEchoReps: DWORD; // echo replies
dwTimestamps: DWORD; // time-stamp requests
dwTimestampReps: DWORD; // time-stamp replies
dwAddrMasks: DWORD; // address mask requests
dwAddrMaskReps: DWORD; // address mask replies
end;
LPMIBICMPSTATS = ^MIBICMPSTATS;
TMIBIcmpStats = MIBICMPSTATS;
PMIBIcmpStats = ^TMIBIcmpStats;

MIBICMPINFO = packed record
icmpInStats: MIBICMPSTATS;
icmpOutStats: MIBICMPSTATS;
end;
LPMIBICMPINFO = ^MIBICMPINFO;
TMIBIcmpInfo = MIBICMPINFO;
PMIBIcmpInfo = ^TMIBIcmpInfo;

MIB_ICMP = packed record
stats: MIBICMPINFO;
end;
LPMIB_ICMP = ^MIB_ICMP;
TMIBIcmp = MIB_ICMP;
PMIBIcmp = ^TMIBIcmp;

////////////////////////////////////////////////////////////////////////////////
// Ping constants
////////////////////////////////////////////////////////////////////////////////
const
PING_DEF_TIMEOUT = 5000;

////////////////////////////////////////////////////////////////////////////////
// ICMP imported functions
////////////////////////////////////////////////////////////////////////////////
function IcmpCreateFile: THandle; stdcall; external ICMP_LIBRARY;
function IcmpCloseHandle(icmpHandle: THandle): BOOL; stdcall; external ICMP_LIBRARY;
function IcmpSendEcho(icmpHandle: THandle; DestinationAddress: TInAddr; RequestData: Pointer; RequestSize: Word; RequestOptions: Pointer; ReplyBuffer: Pointer; ReplySize, Timeout: DWORD): DWORD; stdcall; external ICMP_LIBRARY;
function GetIcmpStatistics(pStats: LPMIB_ICMP): DWORD; stdcall; external IPHLPAPI_LIBRARY;

////////////////////////////////////////////////////////////////////////////////
//
// GetLocalIPAddress
//
// Returns
//
// Returns the local ip address string in the form of x.x.x.x if
// successful, an empty string on failure.
//
////////////////////////////////////////////////////////////////////////////////
function GetLocalIPAddress: String;

////////////////////////////////////////////////////////////////////////////////
//
// GetTraceRoute
//
// HostName = [in] The name of the host system to trace a route to. The
// name can be in either DNS format, or dotted name notation.
//
// List = [in] A TStrings or descendant class to fill in with the
// result of the trace route to the specified host name. The
// string values in the list will contain the IP address in
// x.x.x.x notation, and the Objects[x] property for each list
// item will be the integer value for round trip time.
//
// Returns
//
// If the trace completes, an ERROR_SUCCESS will be returned. Otherwise,
// the error code causing the failure will be returned.
//
////////////////////////////////////////////////////////////////////////////////
function GetTraceRoute(HostName: String; List: TStrings): Integer;

////////////////////////////////////////////////////////////////////////////////
//
// Ping
//
// HostName = [in] The name of the host system to get the network address
// for. The name can be in either DNS format, or dotted name
// notation.
//
// TimeOut = [in/out] On input, determines how long to wait (in ms) for
// an echo reply from the host system. If zero is passed, the
// default timeout of PING_DEF_TIMEOUT is used. On return, this
// will be filled in with the roundtrip time (in ms) to the host.
//
// Returns
//
// Returns ERROR_SUCCESS if the host replied to the echo command, else
// the error code indicating the failure.
//
////////////////////////////////////////////////////////////////////////////////
function Ping(HostName: String; var Timeout: DWORD): Integer;

////////////////////////////////////////////////////////////////////////////////
//
// ResolveAddress
//
// HostName = [in] The name of the host system to get the network address
// for. The name can be in either DNS format, or dotted name
// notation.
//
// Address = [out] The binary address of the host system on success.
//
// Returns
//
// Returns ERROR_SUCCESS if the host name was converted to a binary ip
// address, else the error code indicating the failure. On success, the
// Address param will be filled in with the binary ip address.
//
////////////////////////////////////////////////////////////////////////////////
function ResolveAddress(HostName: String; out Address: DWORD): Integer;

////////////////////////////////////////////////////////////////////////////////
//
// TraceRoute
//
// HostName = [in] The name of the host system to trace a route to. The
// name can be in either DNS format, or dotted name notation.
//
// CallBack = [in] The function to callback when an address hop is
// resolved. This is not a required param, but if passed in,
// returning a False result from the callback will cause the
// trace to complete with a result of ERROR_CANCELLED.
//
// lParam = [in] Specifies a 32-bit, application-defined value to be
// passed to the callback function.
//
// Returns
//
// If the trace completes, an ERROR_SUCCESS will be returned. Otherwise,
// the error code causing the failure will be returned.
//
////////////////////////////////////////////////////////////////////////////////
type
TTraceCallback = function(HopNumber: Byte; Address: PChar; RoundTripTime: Cardinal; lParam: Integer): Boolean;

function TraceRoute(HostName: String; CallBack: TTraceCallback; lParam: Integer): Integer;

implementation

////////////////////////////////////////////////////////////////////////////////
// Protected variables
////////////////////////////////////////////////////////////////////////////////
var
lpData: TWSAData;

function ResolveAddress(HostName: String; out Address: DWORD): Integer;
var lpHost: PHostEnt;
begin

// Set default address
Address:=DWORD(INADDR_NONE);

// Resource protection
try
// Check host name length
if (Length(HostName) > 0) then
begin
// Try converting the hostname
Address:=inet_addr(PChar(HostName));
// Check address
if (DWORD(Address) = DWORD(INADDR_NONE)) then
begin
// Attempt to get host by name
lpHost:=gethostbyname(PChar(HostName));
// Check host ent structure for valid ip address
if Assigned(lpHost) and Assigned(lpHost^.h_addr_list^) then
begin
// Get the address from the list
Address:=u_long(PLongInt(lpHost^.h_addr_list^)^);
end;
end;
end;
finally
// Check result address
if (DWORD(Address) = DWORD(INADDR_NONE)) then
// Invalid host specified
result:=IP_BAD_DESTINATION
else
// Converted correctly
result:=ERROR_SUCCESS;
end;

end;

function GetTraceRouteCallback(HopNumber: Byte; Address: PChar; RoundTripTime: Cardinal; lParam: Integer): Boolean;
begin

// Resource protection
try
// Add address and round trip time to list
TStrings(lParam).AddObject(Address, Pointer(RoundTripTime));
finally
// Keep enumerating
result:=True;
end;

end;

function GetTraceRoute(HostName: String; List: TStrings): Integer;
begin

// Check the passed list
if Assigned(List) then
begin
// Lock the list
List.BeginUpdate;
// Resource protection
try
// Clear the list
List.Clear;
// Perform the trace route
result:=TraceRoute(HostName, GetTraceRouteCallback, Integer(List));
finally
// Unlock the list
List.EndUpdate;
end;
end
else
// List must be passed
result:=ERROR_INVALID_PARAMETER;

end;

function Ping(HostName: String; var Timeout: Cardinal): Integer;
var lpSend: Array [0..7] of Integer;
lpReply: PICMPEchoReply;
icmpHandle: THandle;
dwAddress: DWORD;
dwTTL: DWORD;
begin

// Convert the address
result:=ResolveAddress(HostName, dwAddress);

// Check result
if (result = ERROR_SUCCESS) then
begin
// Open an icmp handle
icmpHandle:=IcmpCreateFile;
// Check handle
if not(icmpHandle = INVALID_HANDLE_VALUE) then
begin
// Resource protection
try
// Allocate memory for reply
lpReply:=AllocMem(SizeOf(ICMP_ECHO_REPLY) * 2 + SizeOf(lpSend));
// Resource protection
try
// Get timeout value
if (Timeout = 0) then
// Use default
dwTTL:=PING_DEF_TIMEOUT
else
// Use passed value
dwTTL:=Timeout;
// Send echo to the host
if (IcmpSendEcho(icmpHandle, in_addr(dwAddress), @lpSend, SizeOf(lpSend), nil, lpReply, SizeOf(ICMP_ECHO_REPLY) + SizeOf(lpSend), dwTTL) = 1) then
begin
// Fill in the round trip time
Timeout:=lpReply^.RTTime;
// Return the status
result:=lpReply^.Status;
end
else
// Request timed out
result:=IP_REQ_TIMED_OUT;
finally
// Free memory
FreeMem(lpReply);
end;
finally
// Close handle
IcmpCloseHandle(icmpHandle);
end;
end
else
// Failed to open icmp handle, return last error
result:=GetLastError;
end;

end;

function TraceRoute(HostName: String; CallBack: TTraceCallback; lParam: Integer): Integer;
var lpSend: Array [0..7] of Integer;
lpAddr: Array [0..255] of Char;
lpOpts: TICMPOptionInformation;
lpReply: PICMPEchoReply;
icmpHandle: THandle;
dwAddress: DWORD;
dwAttempt: Integer;
dwTTL: Integer;
begin

// Convert the address
result:=ResolveAddress(HostName, dwAddress);

// Check result
if (result = ERROR_SUCCESS) then
begin
// Open an icmp handle
icmpHandle:=IcmpCreateFile;
// Check handle
if not(icmpHandle = INVALID_HANDLE_VALUE) then
begin
// Resource protection
try
// Clear option structure
FillChar(lpOpts, SizeOf(lpOpts), 0);
// Allocate memory for reply
lpReply:=AllocMem(SizeOf(ICMP_ECHO_REPLY) * 2 + SizeOf(lpSend));
// Resource protection
try
// Set starting TTL count
dwTTL:=1;
// Perform the trace route
while (dwTTL < 256) do
begin
// Set option time to live
lpOpts.Ttl:=Char(dwTTL);
// Set starting attempt
dwAttempt:=0;
// Retry up to 3 times
while (dwAttempt < 3) do
begin
// Send 32 bytes of data, break on success
if (IcmpSendEcho(icmpHandle, in_addr(dwAddress), @lpSend, SizeOf(lpSend), @lpOpts, lpReply, SizeOf(ICMP_ECHO_REPLY) + SizeOf(lpSend), 1000) = 1) then break;
// Increment the attempt
Inc(dwAttempt);
end;
// Check attempt counter
if (dwAttempt = 3) then
begin
// Set result
result:=IP_REQ_TIMED_OUT;
// Done
break;
end;
// Check callback
if Assigned(Callback) then
begin
// Copy address
StrLCopy(@lpAddr, inet_ntoa(in_addr(lpReply^.Address)), Pred(SizeOf(lpAddr)));
// If false is returned then we need to stop the trace route
if not(Callback(Ord(dwTTL), lpAddr, lpReply^.RTTime, lParam)) then
begin
// Set result
result:=ERROR_CANCELLED;
// Done
break;
end;
end;
// Check reply status, if IP_SUCCESS then we have reached the desired host
if (lpReply^.Status = IP_SUCCESS) then break;
// Increment the time to live
Inc(dwTTL);
end;
finally
// Free memory
FreeMem(lpReply);
end;
finally
// Close handle
IcmpCloseHandle(icmpHandle);
end;
end
else
// Failed to open icmp handle, return last error
result:=GetLastError;
end;

end;

function GetLocalIPAddress: String;
var lpszName: Array [0..MAX_PATH] of Char;
lpHost: PHostEnt;
begin

// Get host name
if (gethostname(@lpszName, SizeOf(lpszName)) = 0) then
begin
// Get host ent structure from remote name
lpHost:=gethostbyname(@lpszName);
// Check host ent structure for valid ip address
if Assigned(lpHost) and Assigned(lpHost^.h_addr_list^) then
// Convert to dot notation string
result:=inet_ntoa(in_addr(PLongInt(lpHost^.h_addr_list^)^))
else
// Failed to resolve name
SetLength(result, 0);
end
else
// Failed to get name
SetLength(result, 0);

end;

initialization

// Initialize winsock
WSAStartup(MakeWord(1, 1), lpData);

finalization

// Cleanup winsock
WSACleanup;

end.

ASKER CERTIFIED SOLUTION

Russell Libby

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

namuh1

rllibby, thanks for ICMPUtils.pas - it's saved me several hours of work. I noticed your website doesn't have your latest version (posted above) hosted there. It'd be great to see that up to date.

I found it necessary to change typecast inet_addr() in line 201.

Address := inet_addr(PChar(HostName));

becomes

Address := DWORD(inet_addr(PChar(HostName)));

in order to avoid range check errors.