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

Протокол 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
Category:Связь
Category:WinAPI