delphi ping scanner исходник интернет icmp. dll delphi ping интернет icmp. dll Русское программирование на Delphi. network

 https://delphisources.ru/forum/showthread.php?t=29617
http://www.delphimaster.ru/articles/icmp.html
https://www.thoughtco.com/implementing-ping-without-using-raw-sockets-4068869
http://www.codenet.ru/progr/delphi/stat/ping.php
http://forum.delphimaster.net/cgi-bin/forum.pl?id=1530002471&n=4&toprint=1
http://forum.delphimaster.net/cgi-bin/forum.pl?id=1530002471&n=4
https://kursovik.com/programming.html?lang=delphi


Вернуться           Форум по Delphi программированию > Все о Delphi > Интернет и сети
Перезагрузить страницу Нужно сделать ping на Delphi

Всем доброго времени суток! Задача избитая, но полноценного решения не нашел. Нужно сделать ping на Delphi. Нашел вроде хороший пример http://www.delphimaster.ru/articles/icmp.html , но не хватает мозгов как сделать, что бы размер буффера можно бло указывать произвольно? Не хватает мозгов переделать на динамический массив буффера данных. Кроме того хотелось бы услышать мнение по правильности этого кода, есть мнение, что этот код может вызывать утечки памяти... И еще интересно - в Delphi XE случайно не сделали "обертку" под использование функций из ICMP.DLL?





unit PingUnits;
 
interface
 
function Ping(Address:RawByteString):Boolean;
 
implementation
 
uses
  Windows, Winsock, SysUtils;
 
const
  IP_STATUS_BASE=11000;
  IP_SUCCESS=0;
  IP_BUF_TOO_SMALL=11001;
  IP_DEST_NET_UNREACHABLE=11002;
  IP_DEST_HOST_UNREACHABLE=11003;
  IP_DEST_PROT_UNREACHABLE=11004;
  IP_DEST_PORT_UNREACHABLE=11005;
  IP_NO_RESOURCES=11006;
  IP_BAD_OPTION=11007;
  IP_HW_ERROR=11008;
  IP_PACKET_TOO_BIG=11009;
  IP_REQ_TIMED_OUT=11010;
  IP_BAD_REQ=11011;
  IP_BAD_ROUTE=11012;
  IP_TTL_EXPIRED_TRANSIT=11013;
  IP_TTL_EXPIRED_REASSEM=11014;
  IP_PARAM_PROBLEM=11015;
  IP_SOURCE_QUENCH=11016;
  IP_OPTION_TOO_BIG=11017;
  IP_BAD_DESTINATION=11018;
  IP_ADDR_DELETED=11019;
  IP_SPEC_MTU_CHANGE=11020;
  IP_MTU_CHANGE=11021;
  IP_UNLOAD=11022;
  IP_GENERAL_FAILURE=11050;
  IP_PENDING=11255;
 
  MAX_IP_STATUS=IP_GENERAL_FAILURE;
 
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';
 
 
 
function PingIp(Address:RawByteString):Boolean;
var
  hIP : THandle;
  pingBuffer : array [0..31] of Char;
  pIpe : ^icmp_echo_reply;
  wVersionRequested : WORD;
  lwsaData : WSAData;
  error : DWORD;
  destAddress : In_Addr;
begin
  Result:=False;
  hIP := IcmpCreateFile();
  GetMem( pIpe,
          sizeof(icmp_echo_reply) + sizeof(pingBuffer));
  try
    pIpe.Data := @pingBuffer;
    pIpe.DataSize := sizeof(pingBuffer);
 
    wVersionRequested := MakeWord(1,1);
    error := WSAStartup(wVersionRequested,lwsaData);
    if (error <> 0) then
    begin
      Exit;
    end;
    destAddress.S_addr:=inet_addr(PAnsiChar(Address));
    IcmpSendEcho(hIP,
                 destAddress.S_addr,
                 @pingBuffer,
                 sizeof(pingBuffer),
                 Nil,
                 pIpe,
                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                 5000);
 
    error := GetLastError();
    if (error <> 0) then
    begin
      Exit;
    end;
    Result:=pIpe.Status=IP_SUCCESS;
  finally
    IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
  end;
end;
 
function HostToIP(name: RawByteString; var Ip: RawByteString): Boolean;
var
  wsdata : TWSAData;
  hostName : array [0..255] of ansichar;
  hostEnt : PHostEnt;
  addr : PAnsiChar;
begin
  WSAStartup ($0101, wsdata);
  try
    gethostname (@hostName[0], sizeof (hostName));
    StrPCopy(hostName, name);
    hostEnt := gethostbyname (hostName);
    if Assigned (hostEnt) then
      if Assigned (hostEnt^.h_addr_list) then begin
        addr := hostEnt^.h_addr_list^;
        if Assigned (addr) then begin
          IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
          byte (addr [1]), byte (addr [2]), byte (addr [3])]);
          Result := True;
        end
        else
          Result := False;
      end
      else
        Result := False
    else begin
      Result := False;
    end;
  finally
    WSACleanup;
  end
end;
 
function Ping(Address:RawByteString):Boolean;
var
  s:RawByteString;
 
begin
  Result:=HostToIP(Address,s);
  if Result then
    Result:=PingIp(s);
end;
 
 
end.




////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
unit PingUnits;
 
interface
 
function Ping(Address:RawByteString):Boolean;
 
implementation
 
uses
  Windows, Winsock, SysUtils;
 
const
  IP_STATUS_BASE=11000;
  IP_SUCCESS=0;
  IP_BUF_TOO_SMALL=11001;
  IP_DEST_NET_UNREACHABLE=11002;
  IP_DEST_HOST_UNREACHABLE=11003;
  IP_DEST_PROT_UNREACHABLE=11004;
  IP_DEST_PORT_UNREACHABLE=11005;
  IP_NO_RESOURCES=11006;
  IP_BAD_OPTION=11007;
  IP_HW_ERROR=11008;
  IP_PACKET_TOO_BIG=11009;
  IP_REQ_TIMED_OUT=11010;
  IP_BAD_REQ=11011;
  IP_BAD_ROUTE=11012;
  IP_TTL_EXPIRED_TRANSIT=11013;
  IP_TTL_EXPIRED_REASSEM=11014;
  IP_PARAM_PROBLEM=11015;
  IP_SOURCE_QUENCH=11016;
  IP_OPTION_TOO_BIG=11017;
  IP_BAD_DESTINATION=11018;
  IP_ADDR_DELETED=11019;
  IP_SPEC_MTU_CHANGE=11020;
  IP_MTU_CHANGE=11021;
  IP_UNLOAD=11022;
  IP_GENERAL_FAILURE=11050;
  IP_PENDING=11255;
 
  MAX_IP_STATUS=IP_GENERAL_FAILURE;
 
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';
 
 
 
function PingIp(Address:RawByteString):Boolean;
var
  hIP : THandle;
  pingBuffer : array [0..31] of Char;
  pIpe : ^icmp_echo_reply;
  wVersionRequested : WORD;
  lwsaData : WSAData;
  error : DWORD;
  destAddress : In_Addr;
begin
  Result:=False;
  hIP := IcmpCreateFile();
  GetMem( pIpe,
          sizeof(icmp_echo_reply) + sizeof(pingBuffer));
  try
    pIpe.Data := @pingBuffer;
    pIpe.DataSize := sizeof(pingBuffer);
 
    wVersionRequested := MakeWord(1,1);
    error := WSAStartup(wVersionRequested,lwsaData);
    if (error <> 0) then
    begin
      Exit;
    end;
    destAddress.S_addr:=inet_addr(PAnsiChar(Address));
    IcmpSendEcho(hIP,
                 destAddress.S_addr,
                 @pingBuffer,
                 sizeof(pingBuffer),
                 Nil,
                 pIpe,
                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                 5000);
 
    error := GetLastError();
    if (error <> 0) then
    begin
      Exit;
    end;
    Result:=pIpe.Status=IP_SUCCESS;
  finally
    IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
  end;
end;
 
function HostToIP(name: RawByteString; var Ip: RawByteString): Boolean;
var
  wsdata : TWSAData;
  hostName : array [0..255] of ansichar;
  hostEnt : PHostEnt;
  addr : PAnsiChar;
begin
  WSAStartup ($0101, wsdata);
  try
    gethostname (@hostName[0], sizeof (hostName));
    StrPCopy(hostName, name);
    hostEnt := gethostbyname (hostName);
    if Assigned (hostEnt) then
      if Assigned (hostEnt^.h_addr_list) then begin
        addr := hostEnt^.h_addr_list^;
        if Assigned (addr) then begin
          IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
          byte (addr [1]), byte (addr [2]), byte (addr [3])]);
          Result := True;
        end
        else
          Result := False;
      end
      else
        Result := False
    else begin
      Result := False;
    end;
  finally
    WSACleanup;
  end
end;
 
function Ping(Address:RawByteString):Boolean;
var
  s:RawByteString;
 
begin
  Result:=HostToIP(Address,s);
  if Result then
    Result:=PingIp(s);
end;
 
 
end.



В общем вместо
Код:
1
    
pingBuffer : array [0..31] of AnsiChar;
я написал
Код:
1
    
pingBuffer : array of AnsiChar;
Потом инициализирую переменную
Код:
1
    
SetLength(pingBuffer, 1452);
и заменил везде
Код:
1
    
sizeof(pingBuffer)
на
Код:
1
    
Length(pingBuffer)
Адрес массива передаю также:
Код:
1
    
pIpe.Data := @pingBuffer;
Вроде все работает, но вопрос - правильно ли я все сделал? Больше всего волнует вопрос: передача адреса на статический и динамический массив одинаково выполняется в Делфи? Я имею ввиду синтаксически...

Да, на счет 64 байт я тоже заметил, поэтому явно везде указал AnsiChar. А за @pingBuffer[0] спасибо, ошибок при работе не вызвало, остается только креститься и молиться, что бы работало



 Note that the Winsock 1.1 WSAStartup function must be called prior to using the functions exposed by ICMP.DLL. If you do not do this, the first call to IcmpSendEcho will fail with error 10091 (WSASYSNOTREADY).

Below you can find the Ping unit's source code. Here are two examples of usage.
Example 1: Code Snippet

uses Ping;...​
const ADP_IP = '208.185.127.40'; (* http://delphi.about.com *)
beginIf  Ping.Ping(ADP_IP) then ShowMessage('About Delphi Programming reachable!');
end;

Example 2: Console Mode Delphi Program

Our next example is a console mode Delphi program that uses the Ping unit: . Here's the Ping unit's source:

unit Ping;​
interfaceuses
Windows, SysUtils, Classes;
type
TSunB = packed record
s_b1, s_b2, s_b3, s_b4: byte;
end;
TSunW = packed record
s_w1, s_w2: word;
end;
PIPAddr = ^TIPAddr;
TIPAddr = record
case integer of
0: (S_un_b: TSunB);1: (S_un_w: TSunW);2: (S_addr: longword);
end;IPAddr = TIPAddr;
function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean;
stdcall; external 'icmp.dll'
function IcmpSendEcho
(IcmpHandle : THandle; DestinationAddress : IPAddr;
RequestData : Pointer; RequestSize : Smallint;
RequestOptions : pointer;
ReplyBuffer : Pointer;
ReplySize : DWORD;
Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';
function Ping(InetAddress : string) : boolean;
implementationuses
WinSock;
function Fetch(var AInput: string;
const ADelim: string = ' ';
const ADelete: Boolean = true)
: string;
var
iPos: Integer;
begin
if ADelim = #0 then begin
// AnsiPos does not work with #0
iPos := Pos(ADelim, AInput);
end else begin
iPos := Pos(ADelim, AInput);
end;
if iPos = 0 then begin
Result := AInput;
if ADelete then begin
AInput := '';
end;
end else begin
result := Copy(AInput, 1, iPos - 1);
if ADelete then begin
Delete(AInput, 1, iPos + Length(ADelim) - 1);
end;
end;
end;
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
phe: PHostEnt;pac: PChar;GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PChar(AIP));
if Assigned(phe) thenbegin
pac := phe^.h_addr_list^;
if Assigned(pac) then
begin
with TIPAddr(AInAddr).S_un_b do begin
s_b1 := Byte(pac[0]);s_b2 := Byte(pac[1]);s_b3 := Byte(pac[2]);s_b4 := Byte(pac[3]);
end;
end
else
begin
raise Exception.Create('Error getting IP from HostName');
end;
end
else
begin
raise Exception.Create('Error getting HostName');
end;
except
FillChar(AInAddr, SizeOf(AInAddr), #0);
end;WSACleanup;
end;
function Ping(InetAddress : string) : boolean;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
rep : array[1..128] of byte;
begin
result := false;Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Exit;
TranslateStringToTInAddr(InetAddress, InAddr);
DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);Result := (DW 0);IcmpCloseHandle(Handle);
end;​
end.
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////




Пингуем (Ping) под Delphi
1
Пингуем (Ping) под Delphi

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

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

    Запускаем Delphi;
    В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
    Вставляем “winsock”;
    объявляем структурку для IP-заголовка:

type IPINFO = record
  Ttl     : char;
  Tos     : char;
  IPFlags : char;
  OptSize : char;
  Options : ^char;
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 := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(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 :char;
Tos :char;
IPFlags :char;
OptSize :char;
Options :^char;
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 := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(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.