EOMY.NET
Хостинг EOMY.NET: Форум поддержки
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 
RSS Feed  

Ping средствами Delphi

 
Начать новую тему   Ответить на тему    Список форумов EOMY.NET -> Программирование для PC (Windows/Linux/DOS)
Ping средствами Delphi
Автор Сообщение
onyx
11 1110 1000
11 1110 1000


Зарегистрирован: 02.04.2007
Сообщения: 1061
Откуда: Минск
598 Монеты

СообщениеДобавлено: Вс, 30 Дек, 2007 17:01    Заголовок сообщения: 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 на своем компьютере в командной строке, следует набрать:
Цитата:
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 мсек

Более подробное описание этой утилиты есть в справке Windows, не будем на этом зацикливаться.
Так вот, принцип работы delphi-приложения, основанного на данной утилите, будет не сложным. Будет необходимым передать утилите необходимые параметры, а именно IP-адрес, и принять результат работы. Не сложно, правда?
Вот небольшая процедурка:

Код:
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 результат работы.
Вот пример использования:
Код:
Ping('127.0.0.1', Memo1);


Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus.
Код:
IdIcmpClient1.Ping;
Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));



Если нет желания связывается с Idy можно использовать библиотеку "ICMP.DLL"
Код:
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);

_________________
DelphiLand.net - Территория Delphi :: Исходники, компоненты, программы, статьи, журнал, форум.
Последние новости. И многое, многое другое!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail Посетить сайт автора
onyx
11 1110 1000
11 1110 1000


Зарегистрирован: 02.04.2007
Сообщения: 1061
Откуда: Минск
598 Монеты

СообщениеДобавлено: Вс, 30 Дек, 2007 17:01    Заголовок сообщения: Ответить с цитатой

ICS - Internet Component Suite - богатый набор компонентов (TWSocket (TCP/IP, UDP - клиент, сервер), TsmtpCli (отправка почты), Tpop3Cli (получение почты), TftpCli (FTP клиент), TFtpSrv (FTP Сервер), ThttpCli (Веб клиент), THttpSrv (Веб сервер), Tping (он родимый и есть) и тд. и тп.). Скачать этот набор можно здесь.
Для пинга необходим лишь TPing.
Вот исходник-пример для пинга из архива с компонентом:
Код:
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.

_________________
DelphiLand.net - Территория Delphi :: Исходники, компоненты, программы, статьи, журнал, форум.
Последние новости. И многое, многое другое!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail Посетить сайт автора
onyx
11 1110 1000
11 1110 1000


Зарегистрирован: 02.04.2007
Сообщения: 1061
Откуда: Минск
598 Монеты

СообщениеДобавлено: Вс, 30 Дек, 2007 17:02    Заголовок сообщения: Ответить с цитатой

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

_________________
DelphiLand.net - Территория Delphi :: Исходники, компоненты, программы, статьи, журнал, форум.
Последние новости. И многое, многое другое!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail Посетить сайт автора
onyx
11 1110 1000
11 1110 1000


Зарегистрирован: 02.04.2007
Сообщения: 1061
Откуда: Минск
598 Монеты

СообщениеДобавлено: Вс, 30 Дек, 2007 17:03    Заголовок сообщения: Ответить с цитатой

(с)
Статья практически не моя. Сам собрал лишь одну процедуру, а остальное путем серфинга, в основном с немецких сайтов (подозрительно... видать гитлеры не все вымерли, пробивают айпишнеги блин Laughing ) + на Вики брал основное понятие пинга.
_________________
DelphiLand.net - Территория Delphi :: Исходники, компоненты, программы, статьи, журнал, форум.
Последние новости. И многое, многое другое!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail Посетить сайт автора
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов EOMY.NET -> Программирование для PC (Windows/Linux/DOS) Часовой пояс: GMT
Страница 1 из 1

 


Rambler's Top100   Рейтинг@Mail.ru    



Powered by phpBB © 2001, 2005 phpBB Group