Solved

Ping result missing some failures

Posted on 2008-06-18
8
2,798 Views
Last Modified: 2010-07-19
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

0
Comment
Question by:mikelittlewood
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 21811204
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

0
 
LVL 15

Author Comment

by:mikelittlewood
ID: 21811301
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?
0
 
LVL 15

Author Comment

by:mikelittlewood
ID: 21811668
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.
0
 
LVL 36

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 25 total points
ID: 21812106
port number 0 is for echo reply
send anything to that port and it should come back the same (echo = echo)

here is the whole unit ... :)
unit PingThread;
 

interface
 

uses

  Classes, IdICMPClient, SysUtils;
 

const

  idLostConnection     = 1;

  idLostConnectionNext = 2;

  idReconnected        = 3;

  idStart              = 4;

  idStop               = 5;

  idEnd                = 6;

  idPing               = 7;

  idPingMessage        = 8;

  idStrayMessage       = 9;

  idRestart            = 10;
 

  MaxMessagesQueue     = 200;
 

type

  TPingThread = class(TThread)

  private

    FHost: string; //host to ping

    FIP: string;

    FInterval: integer;

    FTimeOut: integer;

    FPing: TIdIcmpClient;

    FLastSuccess: TDateTime;

    FLastFailed: TDateTime;

    FFailedSeconds: Int64;

    FStarted: TDateTime;

    FInFail: Boolean;

    FFirst: Boolean;

    FSingleTest: Boolean;

    FTotalFails: Integer;

    FLogPath: string;

    FLastLog: string;

    FFM: TFormatSettings;

    FSequence: word;

    procedure PingReply (ASender: TComponent; const AReplyStatus: TReplyStatus);

  protected

    procedure Execute; override;

  public

    constructor Create(AHost, AIPAddress, ALogPath: string; ASequence: word; ATimeOut: Integer;

      FM: TFormatSettings; ASingleTest: Boolean = False); reintroduce;

    destructor Destroy; override;
 

    property Host: string read FHost;

    property IP: string read FIP;

  end;
 

procedure RunPing(AHost, AIPAddress, ALogPath: string; ATimeOut: Integer; FM: TFormatSettings; ASingleTest: Boolean = False);

procedure StopPing(AHost: string; TheThread: TThread = nil);

procedure HaltPing;

function FindPing(AHost: string; FM: TFormatSettings): string;
 

implementation
 

uses DateUtils, untThreadObjects, Math, Windows;
 

var

  PingList: TThreadList;

  nSequence: word = 0;
 

procedure RunPing(AHost, AIPAddress, ALogPath: string; ATimeOut: Integer; FM: TFormatSettings; ASingleTest: Boolean = False);

var aThread: TPingThread;

  I: Integer;

  Found: Boolean;

begin

  Found := False;

  with PingList.LockList do

  try

    for I := 0 to Count - 1 do

      if SameText(TPingThread(Items[I]).Host, AHost) then

      begin

        Found := True;

        Break;

      end;

  finally

    PingList.UnlockList;

  end;

  if not Found then

  begin

    inc(nSequence);

    with PingList.LockList do

    try

      aThread := TPingThread.Create(AHost, AIPAddress, ALogPath, nSequence, ATimeOut, FM, ASingleTest);

      if not ASingleTest then

        Add(aThread);

      aThread.Resume;

    finally

      PingList.UnlockList;

    end;

  end;

end;
 

procedure StopPing(AHost: string; TheThread: TThread = nil);

var I: Integer;

  aThread: TPingThread;

  aIP: string;

begin

  with PingList.LockList do

  try

    for I := Count - 1 downto 0 do

    begin

      aThread := TPingThread(Items[I]);

      if ((TheThread = nil) and SameText(aThread.Host, aHost)) or

        ((TheThread <> nil) and (aThread = TheThread)) then

      begin

        Delete(I);

        aIP := aThread.IP;

        if TheThread = nil then

          aThread.Terminate;

        FIFOPush(idStop, AHost + '||' + AIP);

      end;

    end;

  finally

    PingList.UnlockList;

  end;

end;
 

procedure HaltPing;

var I: Integer;

  aThread: TPingThread;

begin

  with PingList.LockList do

  try

    for I := Count - 1 downto 0 do

    begin

      aThread := TPingThread(Items[I]);

      Delete(I);

      aThread.Terminate;

    end;

  finally

    PingList.UnlockList;

  end;

end;
 

function FindPing(AHost: string; FM: TFormatSettings): string;

begin

  Result := '';

  RunPing(AHost, '', '', 300, FM, True);

end;
 

{ TPingThread }
 

constructor TPingThread.Create(AHost, AIPAddress, ALogPath: string; ASequence: word; ATimeOut: Integer; FM: TFormatSettings; ASingleTest: Boolean = False);

begin

  inherited Create(True);

  FreeOnTerminate := True;

  FHost := AHost;

  FTimeOut := ATimeOut;

  FInterval := 0;

  FPing := TIdIcmpClient.Create(nil);

  if AIPAddress = '' then

    FPing.Host := AHost

  else

    FPing.Host := AIPAddress;

  FPing.OnReply := PingReply;

  FPing.ReceiveTimeout := fTimeOut;

  FFirst := True;

  FFailedSeconds := 0;

  FSingleTest := ASingleTest;

  FInFail := True;

  FTotalFails := 0;

  FLogPath := ALogPath;

  FLastLog := '';

  FFM := FM;

  FIP := AIPAddress;

  FSequence := aSequence;

end;
 

destructor TPingThread.Destroy;

begin

  FreeAndNil(FPing);

  inherited Destroy;

end;
 

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;
 

(*

procedure TPingThread.AddLog(Msg: string; PingOnly: Boolean = False; AddTime: boolean = True);

var

  LogFile: TextFile;

  Temp, aHostFileName: string;

  AHost: string;

begin

  if (FLastLog <> Msg) and (FLogPath <> '') then

  begin

    AHost := FHost + '_ping.log';

    aHostFileName := Format('%s%s',[FLogPath, AHost]);

    AssignFile(LogFile, aHostFileName);

    try

      if FileExists(aHostFileName) then

        Append(LogFile)

      else

        Rewrite(Logfile);

      Temp := '';

      if AddTime then Temp := FormatDateTime('DD/MM/YYYY HH:NN:SS', Now, FFM) + ' - ';

      Writeln(LogFile, Temp + Msg);

    finally

      CloseFile(LogFile);

    end;

  end;

  FLastLog := Msg;

end;

*)
 

initialization

  PingList := TThreadList.Create;

finalization

  FreeAndNil(PingList);

end.

Open in new window

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 21812117
basically you can ping on any port
ping 21 : check if FTP port is open
ping 80 : check if HTTP port is open
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 21813813
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.

0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 75 total points
ID: 21824883
If your looking for a threaded solution, see the example below.

Russell

-- example --
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IcmpUtils, StdCtrls;

const
  WM_PINGDONE       =  WM_USER + 10;

type
  TForm1            =  class(TForm)
     Button1:       TButton;
     ListBox1:      TListBox;
     Label1:        TLabel;
     Edit1:         TEdit;
     Label2:        TLabel;
     procedure      Button1Click(Sender: TObject);
     procedure      ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  private
     // Private declarations
     FCount:        Integer;
  protected
     // Protected declrations
     procedure      WMPingDone(var Message: TMessage); message WM_PINGDONE;
  public
     // Public declarations
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.WMPingDone(var Message: TMessage);
var dwIndex:        Integer;
begin

  // Decrement the count
  Dec(FCount);

  // Determine if button can be enabled
  Button1.Enabled:=(FCount = 0);

  // Lookup the item
  dwIndex:=ListBox1.Items.IndexOf(AddressToString(Message.WParam));

  // Check index
  if (dwIndex >= 0) then
  begin
     // Check result
     if (Message.LParam = 0) then
        ListBox1.Items.Objects[dwIndex]:=Pointer(2)
     else
        ListBox1.Items.Objects[dwIndex]:=Pointer(1);
     // Invalidate
     InvalidateRect(ListBox1.Handle, nil, False);
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var  i:             Integer;
begin

  // Set count
  FCount:=0;

  // Lock the list
  ListBox1.Items.BeginUpdate;

  // Resource protection
  try
     // Disable the button
     Button1.Enabled:=False;
     // Clear the listbox
     ListBox1.Items.Clear;
     // Ping all hosts in the network range
     for i:=0 to 254 do
     begin
        // Queue the ping
        if (PingAsync(Handle, WM_PINGDONE, Edit1.Text + '.' + IntToStr(i), 0) = ERROR_SUCCESS) then
        begin
           // Increment count
           Inc(FCount);
           // Add to list box
           ListBox1.Items.AddObject(Edit1.Text + '.' + IntToStr(i), nil);
        end;
     end;
  finally
     // Unlock the list
     ListBox1.Items.EndUpdate;
  end;

end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var  lpItem:        Pointer;
begin

  // With canvas
  with ListBox1.Canvas do
  begin
     // Get the object
     lpItem:=ListBox1.Items.Objects[Index];
     // Check it
     if Assigned(lpItem) then
     begin
        // Determine if the ping was ok
        if (Integer(lpItem) = 1) then
           // Ping failed
           Brush.Color:=clRed
        else
           // Ping success
           Brush.Color:=clGreen;
     end
     else
        // Use window color
        Brush.Color:=clWindow;
     // Clear item rect
     FillRect(Rect);
     // Draw the text
     DrawText(Handle, PChar(ListBox1.Items[Index]), (-1), Rect, DT_CENTER or DT_NOCLIP);
  end;

end;

end.

-- dfm --
object Form1: TForm1
  Left = 364
  Top = 275
  Width = 308
  Height = 499
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 100
    Top = 16
    Width = 65
    Height = 13
    Alignment = taRightJustify
    Caption = 'Network IP:'
  end
  object Label2: TLabel
    Left = 268
    Top = 16
    Width = 10
    Height = 13
    Caption = '.x'
  end
  object Button1: TButton
    Left = 12
    Top = 12
    Width = 83
    Height = 25
    Caption = 'Ping'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ListBox1: TListBox
    Left = 172
    Top = 40
    Width = 113
    Height = 409
    ItemHeight = 16
    Sorted = True
    Style = lbOwnerDrawFixed
    TabOrder = 1
    OnDrawItem = ListBox1DrawItem
  end
  object Edit1: TEdit
    Left = 172
    Top = 12
    Width = 89
    Height = 21
    TabOrder = 2
    Text = '192.168.1'
  end
end

-- Updated IcmpUtils --
unit IcmpUtils;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  IcmpUtils
//   Author      :  rllibby
//   Date        :  07.18.2006  -  Original
//                  06.19.2008  -  Update to allow for async pinging as well
//                  reverse DNS name lookup, address -> string conversion.
//   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;

////////////////////////////////////////////////////////////////////////////////
//   Threaded ping structure
////////////////////////////////////////////////////////////////////////////////
type
  PPingRequest            =  ^TPingRequest;
  TPingRequest            =  packed record
     hwndNotify:          HWND;
     msgID:               UINT;
     dwAddr:              DWORD;
     dwTimeout:           DWORD;
  end;

////////////////////////////////////////////////////////////////////////////////
//   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;

////////////////////////////////////////////////////////////////////////////////
//
//   AddressToStr
//
//      Address  =  [in] The binary address of the host system to return the
//               dotted name for.
//
//      Returns
//
//         Returns the ip address in the dotted name format of x.x.x.x on success,
//         an empty string on failure
//
////////////////////////////////////////////////////////////////////////////////
function   AddressToString(Address: DWORD): String;

////////////////////////////////////////////////////////////////////////////////
//
//   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;

////////////////////////////////////////////////////////////////////////////////
//
//   PingAync
//
//      Notify   =  [in] The handle of the window that will be notified when the
//                  ping is complete.
//
//      MsgID    =  [in] The user defined message ID that the ping results will
//                  be messaged back on.
//
//      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] 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.
//
//      Returns
//
//         Returns ERROR_SUCCESS if the ping request is created (thread). When
//         the ping request comlpetes, a message of MsgID will be sent back to the
//         window specified by Notify. The WParam will be the address that was
//         pinged (name can be reversed using ResolveName) and the LParam will be
//         the results of the ping request.
//
//
////////////////////////////////////////////////////////////////////////////////
function   PingAsync(Notify: HWND; MsgID: UINT; HostName: String; 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;

////////////////////////////////////////////////////////////////////////////////
//
//   ResolveName
//
//      Address  =  [in] The binary address of the host system to get the name
//                  for.
//
//      Returns
//
//         Returns the (reverse) DNS if the address was looked up and a hostent
//         structure returned, otherwise the dotted name format x.x.x.x for the
//         address is returned.
//
////////////////////////////////////////////////////////////////////////////////
function   ResolveName(Address: PDWORD): String;

////////////////////////////////////////////////////////////////////////////////
//
//   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 PingThreadFunc(PingRequest: PPingRequest): DWORD; stdcall;
var  lpSend:        Array [0..7] of Integer;
     lpReply:       PICMPEchoReply;
     icmpHandle:    THandle;
     dwTTL:         DWORD;
begin

  // Set default result
  result:=ERROR_SUCCESS;

  // Resource protection
  try
     // Resource protection
     try
        // Resource protection
        try
           // 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 (PingRequest^.dwTimeout = 0) then
                       // Use default
                       dwTTL:=PING_DEF_TIMEOUT
                    else
                       // Use passed value
                       dwTTL:=PingRequest^.dwTimeout;
                    // Send echo to the host
                    if (IcmpSendEcho(icmpHandle, in_addr(PingRequest^.dwAddr), @lpSend, SizeOf(lpSend), nil, lpReply, SizeOf(ICMP_ECHO_REPLY) + SizeOf(lpSend), dwTTL) = 1) then
                       // Return the status
                       result:=lpReply^.Status
                    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;
        finally
           // Check notification window
           if IsWindow(PingRequest^.hwndNotify) then
           begin
              // Notify window of completed request
              PostMessage(PingRequest^.hwndNotify, PingRequest^.msgID, PingRequest^.dwAddr, result);
           end;
        end;
     finally
        // Free the passed memory
        FreeMem(PingRequest);
     end;
  finally
     // Exit the thread
     ExitThread(result);
  end;

end;

function PingAsync(Notify: HWND; MsgID: UINT; HostName: String; Timeout: DWORD): Integer;
var  lpRequest:     PPingRequest;
     dwAddress:     DWORD;
     dwThread:      DWORD;
begin

  // Set multi threaded state
  IsMultiThread:=True;
 
  // Convert the address
  result:=ResolveAddress(HostName, dwAddress);

  // Check result
  if (result = ERROR_SUCCESS) then
  begin
     // Create structure for the thread request
     lpRequest:=AllocMem(SizeOf(TPingRequest));
     // Fill in the request fields
     lpRequest^.hwndNotify:=Notify;
     lpRequest^.msgID:=MsgID;
     lpRequest^.dwAddr:=dwAddress;
     lpRequest^.dwTimeout:=Timeout;
     // Create the ping request thread
     if (CreateThread(nil, 0, @PingThreadFunc, lpRequest, 0, dwThread) = 0) then
     begin
        // Failed to create listening thread
        result:=GetLastError;
        // Free memory block
        FreeMem(lpRequest);
     end
     else
        // Success
        result:=ERROR_SUCCESS;
  end;

end;

function AddressToString(Address: DWORD): String;
var  lpszAddr:      PChar;
begin

  // Get the ip address in the dotted name format
  lpszAddr:=inet_ntoa(in_addr(Address));

  // Check result
  if Assigned(lpszAddr) then
     // Return string
     SetString(result, lpszAddr, StrLen(lpszAddr))
  else
     // Return empty string
     SetLength(result, 0);

end;

function ResolveName(Address: PDWORD): String;
var  lpHost:        PHostEnt;
begin

  // Get host by address
  lpHost:=gethostbyaddr(Address, SizeOf(DWORD), AF_INET);

  // Check host ent
  if Assigned(lpHost) and Assigned(lpHost^.h_name) then
     // Return the host name
     SetString(result, lpHost^.h_name, StrLen(lpHost^.h_name))
  else
     // Convert address to dotted format
     result:=AddressToString(Address^)

end;

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.

0
 

Expert Comment

by:namuh1
ID: 29937165
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.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now