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

 
Реклама
Сайты с PegeSpeed 99 - 100%: источник и исполнитель разработки с технической оптимизацией.
DISCLAIMER: All messages made available as part of this discussion group (including any bulletin boards and chat rooms) and any opinions, advice, statements or other information contained in any messages posted or transmitted by any third party are the responsibility of the author of that message. The fact that a particular message is posted on or transmitted using this web site does not mean that we endorsed that message in any way or verified the accuracy, completeness or usefulness of any message. Although we require that all users read and agree with the forum rules, we cannot constantly monitor forum activity. We encourage visitors to the forum to report any objectionable message to moderators. Once again, this forum is not monitored 24/7.


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



Powered by phpBB © 2001, 2005 phpBB Group