unit raw_ping;

interface
uses
  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;

type
 ip_option_information = record
  Ttl : byte;
  Tos : byte;
  Flags : byte;
  OptionsSize : byte;
  OptionsData : pointer;
end;

type
ICMP_ECHO_REPLY =
record
 Address : IPAddr;
 Status : ULONG;
 RoundTripTime : ULONG;
 DataSize : Word;
 Reserved : Word;
 Data : Pointer;
 Options : IP_OPTION_INFORMATION;
 PingBuf: array[0..31] of char;
end;


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;// Пингует заданный адрес
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);// Конвертирование адреса.

implementation

uses
  WinSock;

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) then
   begin
    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;//результат пингования
 Reply  : ICMP_ECHO_REPLY;// Буфер для получения ответа ответа
 PingBuf: array[0..31] of char;// Буфер для отправки
begin
  result := false;// установка что сервер не пингуется
  Handle := IcmpCreateFile;// Создание ICMP
  if Handle = INVALID_HANDLE_VALUE then exit; // Если ошибка, то выход
  TranslateStringToTInAddr(InetAddress, InAddr);// Конвертирование адреса
  Reply.Data := @pingBuf;// Естановка адреса буфера
  Reply.DataSize := 32;// Установка размера бофера
  DW:=IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply)+32  , 3000);// Полыска эхо запроса
  if DW <> 0 then result:=true;// Если !=0 то значит сервак пингуется. Установки пингуеости
  exit;// выход
 // IcmpCloseHandle(Handle); // только для win 9x
end;

end.