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

Тема в разделе "Delphi - FAQ", создана пользователем onyx, 30 дек 2007.

  1. onyx

    onyx Гость

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

    Код (Text):
    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 результат работы.
    Вот пример использования:
    Код (Text):
    Ping('127.0.0.1', Memo1);
    Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus.
    Код (Text):
    IdIcmpClient1.Ping;
    Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));

    Если нет желания связывается с Idy можно использовать библиотеку "ICMP.DLL"
    Код (Text):
    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;
    А вот таким незаурядным кодом в одну строку можно вывести в командной строке результат пинга адреса:
    Код (Text):
    WinExec(pchar('ping.exe sources.ru'), sw_show);

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

    onyx Гость

    <!--QuoteBegin-sax_ol+30:12:2007, 23:21 -->
    <span class="vbquote">(sax_ol @ 30:12:2007, 23:21 )</span><!--QuoteEBegin-->а не проще заюзать Indy?
    [snapback]91896" rel="nofollow" target="_blank[/snapback]​
    [/quote]
    Если бы ты прочитал все, то ты бы не задал этот вопрос. :)
     
  3. onyx

    onyx Гость

    <!--QuoteBegin-sax_ol+31:12:2007, 16:31 -->
    <span class="vbquote">(sax_ol @ 31:12:2007, 16:31 )</span><!--QuoteEBegin-->Много букав
    [snapback]91938" rel="nofollow" target="_blank[/snapback]​
    [/quote]
    Ну... мое дело маленькое. :)
     
  4. valentofer

    valentofer Active Member

    Регистрация:
    10 ноя 2007
    Сообщения:
    38
    Симпатии:
    0
    <!--QuoteBegin-onyx+30:12:2007, 19:47 -->
    <span class="vbquote">(onyx @ 30:12:2007, 19:47 )</span><!--QuoteEBegin-->Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus.
    Код
    IdIcmpClient1.Ping;
    Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));
    [snapback]91882" rel="nofollow" target="_blank[/snapback]​
    [/quote]
    только в Delphi 2007(в ранних не знаю), в компоненте IdIcmpClient1 нету ReplyStatus и TimeToLive ;) А так должно работать :wacko:
     
  5. 3uM6a

    3uM6a Гость

    Хотелось бы узнать как лучше узнать есть ли коннект к интернету ? Ping ом или днслукапом? Смысл в том чтобы функция возвращала true или false ! ПОдскажите как лучше реализовать ?
     
  6. Kmet

    Kmet Well-Known Member
    Java Team

    Регистрация:
    25 май 2006
    Сообщения:
    1.018
    Симпатии:
    1
    не раз обсуждалось. в общем случае надежного решения нет. имхо лучший вариант дергать надежный сервис (гугл, яху...)
     
  7. etc

    etc Гость

    Зачем дергать чтото "надежное"? Дергать надо тог что надо приложению. Иначе дернут гугл - инет есть - дернут свое - инета нет - и так по циклу .... :unsure:
     
  8. Kmet

    Kmet Well-Known Member
    Java Team

    Регистрация:
    25 май 2006
    Сообщения:
    1.018
    Симпатии:
    1
    с чего ты взял, что приложению обязательно что то надо?! может оно тупо мониторит соединение.
     
  9. etc

    etc Гость

    Значит ему надо яхугл, только и всего. :unsure:
     
Загрузка...

Поделиться этой страницей