На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Ping
      Ping средствами Delphi

      Ping — это служебная компьютерная программа, предназначенная для проверки соединений в сетях на основе TCP/IP.

      Она отправляет запросы Echo-Request протокола ICMP указанному узлу сети и фиксирует поступающие ответы (ICMP Echo-Reply). Время между отправкой запроса и получением ответа позволяет определять двусторонние задержки (RTT) по маршруту и частоту потери пакетов, то есть косвенно определять загруженности каналов передачи данных и промежуточных устройств.

      Также пингом называется время, затраченное на передачу пакета информации в компьютерных сетях от клиента к серверу и обратно от сервера к клиенту, оно измеряется в миллисекундах. Время пинга связано со скоростью соединения и загруженностью каналов на всём протяжении от клиента к серверу.

      Полное отсутствие ICMP-ответов может также означать, что удалённый узел (или какой-либо из промежуточных маршрутизаторов) блокирует ICMP Echo-Reply или игнорирует ICMP Echo-Request.

      А теперь конкретно на примерах.

      В основу одного из самого простого способа можно положить стандартную утилиту командной строки ping.exe, входящую в состав Windows.
      Команда Ping лежит в основе диагностики сетей TCP/IP. Например, чтобы быстро получить значения параметров конфигурации TCP/IP на своем компьютере в командной строке, следует набрать:
      ExpandedWrap disabled
        C:\>ping 127.0.0.1

      Результатом данной команды будет:
      ExpandedWrap disabled
        Обмен пакетами с 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 мсек

      Более подробное описание этой утилиты есть в справке Windows, не будем на этом зацикливаться.
      Так вот, принцип работы delphi-приложения, основанного на данной утилите, будет не сложным. Будет необходимым передать утилите необходимые параметры, а именно IP-адрес, и принять результат работы. Не сложно, правда?
      Вот небольшая процедурка:
      ExpandedWrap disabled
        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;

      Процедура отправляет IP адрес и возвращает в TMemo результат работы.
      Вот пример использования:
      ExpandedWrap disabled
        Ping('127.0.0.1', Memo1);


      При подготовке данной статьи были использованы следующие материалы:
      Общее представление о пинге (Википедия)
      Процедура принятия результатов работы консольного приложения (DRKB)

      Добавлено
      Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus.

      Пример кода:
      ExpandedWrap disabled
        IdIcmpClient1.Ping;
        Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));
        Если нет желания связывается с Idy можно использовать библиотеку "ICMP.DLL"
        ExpandedWrap disabled
          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;


        Добавлено
        А вот таким незаурядным кодом в одну строку можно вывести в командной строке результат пинга адреса:
        WinExec(pchar('ping.exe sources.ru'), sw_show);
          А чем так уж Indy не угодили? Или хотя бы ICS? ;)
            ICS - Internet Component Suite - богатый набор компонентов (TWSocket (TCP/IP, UDP - клиент, сервер), TsmtpCli (отправка почты), Tpop3Cli (получение почты), TftpCli (FTP клиент), TFtpSrv (FTP Сервер), ThttpCli (Веб клиент), THttpSrv (Веб сервер), Tping (он родимый и есть) и тд. и тп.). Скачать этот набор можно здесь.
            Для пинга необходим лишь TPing.
            Вот исходник-пример для пинга из архива с компонентом:
            ExpandedWrap disabled
              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.
              Вот уединенный модуль пинга.

              Добавлено
              Во ещё один пример. Надо использовать компонент IdIcmpClient. Этот включает метод Ping, который осуществляет запрос. Информация о посланном ping получена в свойство ReplyStatus компонента. Находим там число полученных байтов (BytesReceived), время в тысяче секунд (MsRoundTripTime), TTL пакета (TimeToLive), и т.д.. Вот в качестве примера функция, позволяющая определить ping, указываем IP или имя. Передаем также в параметре число отправлений, которое должны делать (чем больше число pings, тем результат будет точнее, но операция будет более медленнее выполняться), и Double переменная, в которую поместим результат. Функция отсылает true, если все прошло успешно, false в случае провала:
              ExpandedWrap disabled
                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;

              Прикреплённый файлПрикреплённый файлping.rar (3.18 Кбайт, скачиваний: 943)
              0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
              0 пользователей:


              Рейтинг@Mail.ru
              [ Script execution time: 0,0420 ]   [ 17 queries used ]   [ Generated: 29.03.24, 14:08 GMT ]