Как сделать PING?

Материал из DRKB


Протокол Ping предназначен для тестирования компьютерных соединений в Интернете путём посылки через протокол Internet Protocol (IP) по определённому адресу сообщения и ожидания от него ответа.

ICMP - Internet Control Message Protocol. ICMP служит для передачи сообщений об ошибках а так же управляющих сообщений . ICMP-тест может показать насколько быстро проходит информация между двумя узлами в Интернете.

1. Запускаем Delphi;
2. В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
3. Вставляем "winsock";
4. объявляем структурку для IP-заголовка:
type
  IPINFO = record
    Ttl: Byte;
    Tos: Byte;
    IPFlags: Byte;
    OptSize: Byte;
    Options: ^Byte;
  end;


5. объявляем структурку для хранения ICMP пакета:
type
  ICMPECHO = record
    Source: longint;
    Status: longint;
    RTTime: longint;
    DataSize: Shortint;
    Reserved: Shortint;
    pData: ^variant;
    i_ipinfo: IPINFO;
  end;


6. Объявляем функции и процедуры, которые мы будем вызывать из ICMP.DLL

TIcmpCreateFile = function(): Integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle = procedure(var handle: Integer);{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpSendEcho = function(var handle: Integer; endereco: DWORD; buffer: Variant; tam: WORD;
  IP: IPINFO; ICMP: ICMPECHO; tamicmp: DWORD; tempo: DWORD): DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}


7. В Tbutton в событие Onclick вставляем следующий код:

procedure TForm1.Button1Click(Sender: TObject);
var
  wsadt: wsadata;
  icmp: icmpecho;
  HNDicmp: Integer;
  hndFile: Integer;
  Host: PHostEnt;
  Destino: in_addr;
  Endereco: ^DWORD;
  IP: ipinfo;
  Retorno: Integer;
  dwRetorno: DWORD;
  x: Integer;

  IcmpCreateFile: TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho: TIcmpSendEcho;

begin
  if (edit1.Text = '') then
  begin
    Application.MessageBox('Enter a HostName ro a IP Adress', 'Error', MB_OK);
    exit;
  end;
  HNDicmp := LoadLibrary('ICMP.DLL');
  if (HNDicmp <> 0) then
  begin
    @IcmpCreateFile := GetProcAddress(HNDicmp, 'IcmpCreateFile');
    @IcmpCloseHandle := GetProcAddress(HNDicmp, 'IcmpCloseHandle');
    @IcmpSendEcho := GetProcAddress(HNDicmp, 'IcmpSendEcho');
    if (@IcmpCreateFile = nil) or (@IcmpCloseHandle = nil) or (@IcmpSendEcho = nil) then
    begin
      Application.MessageBox('Error getting ICMP Adress', 'Error', MB_OK);
      FreeLibrary(HNDicmp);
    end;
  end;
  Retorno := WSAStartup($0101, wsadt);

  if (Retorno <> 0) then
  begin
    Application.MessageBox('Canґt Load WinSockets', 'WSAStartup', MB_OK);
    WSACleanup();
    FreeLibrary(HNDicmp);
  end;

  Destino.S_addr := inet_addr(Pchar(Edit1.text));
  if (Destino.S_addr = 0) then
  begin
    Host := GetHostbyName(PChar(Edit1.text));
  end
  else
  begin
    Host := GetHostbyAddr(@Destino, sizeof(in_addr), AF_INET);
  end;

  if (host = nil) then
  begin
    Application.MessageBox('Host not found', 'Error', MB_OK);
    WSACleanup();
    FreeLibrary(HNDicmp);
    exit;
  end;
  memo1.Lines.Add('Pinging ' + Edit1.text);

  Endereco := @Host.h_addr_list;

  HNDFile := IcmpCreateFile();
  for x := 0 to 4 do
  begin
    Ip.Ttl := 255;
    Ip.Tos := 0;
    Ip.IPFlags := 0;
    Ip.OptSize := 0;
    Ip.Options := nil;

    dwRetorno := IcmpSendEcho(
      HNDFile,
      Endereco^,
      null,
      0,
      Ip,
      Icmp,
      sizeof(Icmp),
      DWORD(5000));
    Destino.S_addr := icmp.source;
    Memo1.Lines.Add('Ping ' + Edit1.text);
  end;

  IcmpCLoseHandle(HNDFile);
  FreeLibrary(HNDicmp);
  WSACleanup();
end;


У данного примера есть один недостаток - программа не воспримет доменное имя, только IP-адрес. Для пользователей NT не используйте функцию IcmpCloseHandle.

Это всё…..

Ну и в конце полный исходный код примера:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  winsock, StdCtrls;

type
  IPINFO = record
    Ttl: Byte;
    Tos: Byte;
    IPFlags: Byte;
    OptSize: Byte;
    Options: ^Byte;
  end;

type
  ICMPECHO = record
    Source: longint;
    Status: longint;
    RTTime: longint;
    DataSize: Shortint;
    Reserved: Shortint;
    pData: ^Variant;
    i_ipinfo: IPINFO;
  end;

  TIcmpCreateFile = function(): Integer; {$IFDEF WIN32}stdcall; {$ENDIF}
  TIcmpCloseHandle = procedure(var handle: Integer); {$IFDEF WIN32}stdcall; {$ENDIF}
  TIcmpSendEcho = function(var handle: Integer; endereco: DWORD; buffer: Variant; tam: WORD; IP: IPINFO; ICMP: ICMPECHO; tamicmp: DWORD; tempo: DWORD): DWORD; {$IFDEF WIN32}stdcall; {$ENDIF}

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  wsadt: wsadata;
  icmp: icmpecho;
  HNDicmp: Integer;
  hndFile: Integer;
  Host: PHostEnt;
  Destino: in_addr;
  Endereco: ^DWORD;
  IP: ipinfo;
  Retorno: Integer;
  dwRetorno: DWORD;
  x: integer;

  IcmpCreateFile: TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho: TIcmpSendEcho;

begin
  if (edit1.Text = '') then
  begin
    Application.MessageBox('Digite um HostName ou um End. IP', 'Error', MB_OK);
    exit;
  end;
  HNDicmp := LoadLibrary('ICMP.DLL');
  if (HNDicmp <> 0) then
  begin
    @IcmpCreateFile := GetProcAddress(HNDicmp, 'IcmpCreateFile');
    @IcmpCloseHandle := GetProcAddress(HNDicmp, 'IcmpCloseHandle');
    @IcmpSendEcho := GetProcAddress(HNDicmp, 'IcmpSendEcho');
    if (@IcmpCreateFile = nil) or (@IcmpCloseHandle = nil) or (@IcmpSendEcho = nil) then
    begin
      Application.MessageBox('Erro pegando endereзos ICMP', 'Error', MB_OK);
      FreeLibrary(HNDicmp);
    end;
  end;
  Retorno := WSAStartup($0101, wsadt);

  if (Retorno <> 0) then
  begin
    Application.MessageBox('Nгo foi possнvel carregar WinSockets', 'WSAStartup', MB_OK);
    WSACleanup();
    FreeLibrary(HNDicmp);
  end;

  Destino.S_addr := inet_addr(Pchar(Edit1.text));
  if (Destino.S_addr = 0) then
  begin
    Host := GetHostbyName(PChar(Edit1.text));
  end
  else
  begin
    Host := GetHostbyAddr(@Destino, sizeof(in_addr), AF_INET);
  end;

  if (host = nil) then
  begin
    Application.MessageBox('Host nгo encontrado', 'Error', MB_OK);
    WSACleanup();
    FreeLibrary(HNDicmp);
    exit;
  end;
  memo1.Lines.Add('Pinging ' + Edit1.text);

  Endereco := @Host.h_addr_list;

  HNDFile := IcmpCreateFile();
  for x := 0 to 4 do
  begin
    Ip.Ttl := 255;
    Ip.Tos := 0;
    Ip.IPFlags := 0;
    Ip.OptSize := 0;
    Ip.Options := nil;

    dwRetorno := IcmpSendEcho(
      HNDFile,
      Endereco^,
      null,
      0,
      Ip,
      Icmp,
      sizeof(Icmp),
      DWORD(5000));
    Destino.S_addr := icmp.source;
    Memo1.Lines.Add('Pingou ' + Edit1.text);
  end;

  IcmpCLoseHandle(HNDFile);
  FreeLibrary(HNDicmp);
  WSACleanup();
end;

end.



Source: Взято из http://forum.sources.ru
ID: 03366