function TForm1.Ping(const AHost : string; const ATimes : integer;

                          out AvgMS:Double) : Boolean;

 var

  R : array of Cardinal;

  i : integer;

begin

  Result := True;

  AvgMS := 0;

  if ATimes>0 then

    with TIdIcmpClient.Create(Self) do

    try

        Host := AHost;

        ReceiveTimeout:=999; //TimeOut du ping

        SetLength(R,ATimes);

        {Pinguer le client}

        for i:=0 to Pred(ATimes) do

        begin

            try

              Ping();

              Application.ProcessMessages; //ne bloque pas l'application

              R[i] := ReplyStatus.MsRoundTripTime;

            except

              Result := False;

              Exit;

 

            end;

          if ReplyStatus.ReplyStatusType<>rsEcho Then result := False; //pas d'écho, on renvoi false.

        end;

        {Faire une moyenne}

        for i:=Low(R) to High(R) do

        begin

          Application.ProcessMessages;

          AvgMS := AvgMS + R[i];

        end;

        AvgMS := AvgMS / i;

    finally

        Free;

    end;

end;

unit PingTst1;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  Ping, StdCtrls;

 

type

  TPingTstForm = class(TForm)

    Ping1: TPing;

    Label1: TLabel;

    HostEdit: TEdit;

    PingButton: TButton;

    DisplayMemo: TMemo;

    CancelButton: TButton;

    procedure PingButtonClick(Sender: TObject);

    procedure Ping1Display(Sender: TObject; Icmp: TObject; Msg: String);

    procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);

    procedure CancelButtonClick(Sender: TObject);

    procedure Ping1EchoRequest(Sender: TObject; Icmp: TObject);

    procedure Ping1EchoReply(Sender: TObject; Icmp: TObject; Error: Integer);

  private

    { Dйclarations privйes }

  public

    { Dйclarations publiques }

  end;

 

var

  PingTstForm: TPingTstForm;

 

implementation

 

{$R *.DFM}

 

 

procedure TPingTstForm.PingButtonClick(Sender: TObject);

begin

    DisplayMemo.Clear;

    DisplayMemo.Lines.Add('Resolving host ''' + HostEdit.Text + '''');

    PingButton.Enabled   := FALSE;

    CancelButton.Enabled := TRUE;

    Ping1.DnsLookup(HostEdit.Text);

end;

 

 

procedure TPingTstForm.Ping1DnsLookupDone(Sender: TObject; Error: Word);

begin

    CancelButton.Enabled := FALSE;

    PingButton.Enabled   := TRUE;

 

    if Error <> 0 then begin

        DisplayMemo.Lines.Add('Unknown Host ''' + HostEdit.Text + '''');

        Exit;

    end;

 

    DisplayMemo.Lines.Add('Host ''' + HostEdit.Text + ''' is ' + Ping1.DnsResult);

    Ping1.Address := Ping1.DnsResult;

    Ping1.Ping;

end;

 

 

procedure TPingTstForm.Ping1Display(Sender: TObject; Icmp: TObject; Msg: String);

begin

    DisplayMemo.Lines.Add(Msg);

end;

 

 

 

 

procedure TPingTstForm.CancelButtonClick(Sender: TObject);

begin

    Ping1.CancelDnsLookup;

end;

 

 

 

procedure TPingTstForm.Ping1EchoRequest(Sender: TObject; Icmp: TObject);

begin

    DisplayMemo.Lines.Add('Sending ' + IntToStr(Ping1.Size) + ' bytes to ' +

                          Ping1.HostName + ' (' + Ping1.HostIP + ')');

end;

 

 

 

procedure TPingTstForm.Ping1EchoReply(Sender: TObject; Icmp: TObject; Error: Integer);

begin

    if Error = 0 then

        DisplayMemo.Lines.Add('Cannot ping host (' + Ping1.HostIP + ') : ' +

                              Ping1.ErrorString)

    else

        DisplayMemo.Lines.Add('Received ' + IntToStr(Ping1.Reply.DataSize) +

                              ' bytes from ' + Ping1.HostIP +

                              ' in ' + IntToStr(Ping1.Reply.RTT) + ' msecs');

end;

 

end.

uses

  WinSock;

 

type

    ip_option_information = packed record  // Информация заголовка IP (Наполнение

                    // этой структуры и формат полей описан в RFC791.

        Ttl : byte;         // Время жизни (используется traceroute-ом)

        Tos : byte;         // Тип обслуживания, обычно 0

        Flags : byte;       // Флаги заголовка IP, обычно 0

        OptionsSize : byte;     // Размер данных в заголовке, обычно 0, максимум 40

        OptionsData : Pointer;  // Указатель на данные

    end;

 

   icmp_echo_reply = packed record

        Address : u_long;            // Адрес отвечающего

        Status : u_long;             // IP_STATUS (см. ниже)

        RTTime : u_long;             // Время между эхо-запросом и эхо-ответом

                         // в миллисекундах

        DataSize : u_short;              // Размер возвращенных данных

        Reserved : u_short;              // Зарезервировано

        Data : Pointer;          // Указатель на возвращенные данные

        Options : ip_option_information; // Информация из заголовка IP

    end;

 

    PIPINFO = ^ip_option_information;

    PVOID = Pointer;

 

        function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';

        function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL'  name 'IcmpCloseHandle';

        function IcmpSendEcho(

                          IcmpHandle : THandle;    // handle, возвращенный IcmpCreateFile()

                          DestAddress : u_long;    // Адрес получателя (в сетевом порядке)

                          RequestData : PVOID;     // Указатель на посылаемые данные

                          RequestSize : Word;      // Размер посылаемых данных

                          RequestOptns : PIPINFO;  // Указатель на посылаемую структуру

                                               // ip_option_information (может быть nil)

                          ReplyBuffer : PVOID;     // Указатель на буфер, содержащий ответы.

                          ReplySize : DWORD;       // Размер буфера ответов

                          Timeout : DWORD          // Время ожидания ответа в миллисекундах

                         ) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';

 

procedure TForm1.Button1Click(Sender: TObject);

var

    hIP : THandle;

    pingBuffer : array [0..31] of Char;

    pIpe : ^icmp_echo_reply;

    pHostEn : PHostEnt;

    wVersionRequested : WORD;

    lwsaData : WSAData;

    error : DWORD;

    destAddress : In_Addr;

begin

    

    // Создаем handle

    hIP := IcmpCreateFile();

    

    GetMem( pIpe,

            sizeof(icmp_echo_reply) + sizeof(pingBuffer));

    pIpe.Data := @pingBuffer;

    pIpe.DataSize := sizeof(pingBuffer);

 

    wVersionRequested := MakeWord(1,1);

    error := WSAStartup(wVersionRequested,lwsaData);

    if (error <> 0) then

    begin

         Memo1.SetTextBuf('Error in call to '+

                          'WSAStartup().');

         Memo1.Lines.Add('Error code: '+IntToStr(error));

         Exit;

    end;

    

    pHostEn := gethostbyname('172.16.10.1');

    error := GetLastError();

    if (error <> 0) then

    begin

         Memo1.SetTextBuf('Error in call to'+

                          'gethostbyname().');

         Memo1.Lines.Add('Error code: '+IntToStr(error));

         Exit;

    end;

    

     destAddress := PInAddr(pHostEn^.h_addr_list^)^;

 

      // Посылаем ping-пакет

    Memo1.Lines.Add('Pinging ' +

                    pHostEn^.h_name+' ['+

                    inet_ntoa(destAddress)+'] '+

                    ' with '+

                    IntToStr(sizeof(pingBuffer)) +

                    ' bytes of data:');

 

    IcmpSendEcho(hIP,

                 destAddress.S_addr,

                 @pingBuffer,

                 sizeof(pingBuffer),

                 Nil,

                 pIpe,

                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),

                 5000);

 

    error := GetLastError();

    if (error <> 0) then

    begin

         Memo1.SetTextBuf('Error in call to '+

                          'IcmpSendEcho()');

         Memo1.Lines.Add('Error code: '+IntToStr(error));

         Exit;

    end;

 

     // Смотрим некоторые из вернувшихся данных

    Memo1.Lines.Add('Reply from '+

                IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+

                IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+

                IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+

                IntToStr(HiByte(HiWord(pIpe^.Address))));

    Memo1.Lines.Add('Reply time: '+IntToStr(pIpe.RTTime)+' ms');

 

    IcmpCloseHandle(hIP);

    WSACleanup();

    FreeMem(pIpe);

end;

C:\>ping 127.0.0.1

Обмен пакетами с 127.0.0.1 по 32 байт:

Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128

Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128

Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128

Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128

Статистика Ping для 127.0.0.1:

Пакетов: отправлено = 4, получено = 4, потеряно = 0 (0% потерь),

Приблизительное время приема-передачи в мс:

Минимальное = 0мсек, Максимальное = 0 мсек, Среднее = 0 мсек

procedure Ping(IP: String; OutMemo:TMemo);

const BUFSIZE = 2000;

var SecAttr    : TSecurityAttributes;

   hReadPipe,

   hWritePipe : THandle;

   StartupInfo: TStartUpInfo;

   ProcessInfo: TProcessInformation;

   Buffer     : Pchar;

   WaitReason,

   BytesRead  : DWord;

begin

with SecAttr do

begin

  nlength              := SizeOf(TSecurityAttributes);

  binherithandle       := true;

  lpsecuritydescriptor := nil;

end;

if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then

begin

  Buffer  := AllocMem(BUFSIZE + 1);

  FillChar(StartupInfo, Sizeof(StartupInfo), #0);

  StartupInfo.cb          := SizeOf(StartupInfo);

  StartupInfo.hStdOutput  := hWritePipe;

  StartupInfo.hStdInput   := hReadPipe;

  StartupInfo.dwFlags     := STARTF_USESTDHANDLES +

                             STARTF_USESHOWWINDOW;

  StartupInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil,

     PChar('ping.exe '+IP),

     @SecAttr,

     @SecAttr,

     true,

     NORMAL_PRIORITY_CLASS,

     nil,

     nil,

     StartupInfo,

     ProcessInfo) then

    begin

      repeat

        WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100);

        Application.ProcessMessages;

      until (WaitReason <> WAIT_TIMEOUT);

      Repeat

        BytesRead := 0;

        ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);

        Buffer[BytesRead]:= #0;

        OemToAnsi(Buffer,Buffer);

        OutMemo.Text := OutMemo.text + String(Buffer);

      until (BytesRead < BUFSIZE);

    end;

  FreeMem(Buffer);

  CloseHandle(ProcessInfo.hProcess);

  CloseHandle(ProcessInfo.hThread);

  CloseHandle(hReadPipe);

  CloseHandle(hWritePipe);

end;

end;

Ping('127.0.0.1', Memo1);

IdIcmpClient1.Ping;

Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));