Delphi ping устройств в сети.

[Brain_SHVV]

Здравствуйте.
Делаю биллинговую программу на Delphi в которой используются IP-адреса клиентов, хотелось бы привязать такую функцию как проверка доступности сетевого устройства по средствам ping, но есть проблема, пробовал разные варианты с помощью indy. Проблема в том, когда устройства не в сети, то через определенное время программа выдает ошибку, так как сделано было через таймер. Что нужно сделать и чем проще тем лучше, например: Проверяем доступность IP-адреса и выдаем сообщение в сети устройство или нет. И достаточно проверка одного адреса, но чтобы не выходило ошибок если устройство не в сети и когда это будет выполнятся в цикле или по таймеру. И как вариант, можно было бы поместить данную процедуру в поток, чтобы не грузить программу и не ждать выполнения каждой такой процедуры.

[Slym]

https://yandex.ru/search/?text=ICMP.DLL%20delphi&lr=213

unit Icmp;

interface
uses Windows,WinSock,SysUtils;

Const
  IP_SUCCESS = 0;
  IP_STATUS_BASE = 11000;
  IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1);
  IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2);
  IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3);
  IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4);
  IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5);
  IP_NO_RESOURCES = (IP_STATUS_BASE + 6);
  IP_BAD_OPTION = (IP_STATUS_BASE + 7);
  IP_HW_ERROR = (IP_STATUS_BASE + 8);
  IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9);
  IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10);
  IP_BAD_REQ = (IP_STATUS_BASE + 11);
  IP_BAD_ROUTE = (IP_STATUS_BASE + 12);
  IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13);
  IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14);
  IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15);
  IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16);
  IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17);
  IP_BAD_DESTINATION = (IP_STATUS_BASE + 18);

  // The next group are status codes passed up on status indications to
  // transport layer protocols.
  IP_ADDR_DELETED = (IP_STATUS_BASE + 19);
  IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20);
  IP_MTU_CHANGE = (IP_STATUS_BASE + 21);
  IP_UNLOAD = (IP_STATUS_BASE + 22);
  IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50);
  MAX_IP_STATUS = IP_GENERAL_FAILURE;
  IP_PENDING = (IP_STATUS_BASE + 255);

(*  // Values used in the IP header Flags field.
  IP_FLAG_DF = $2; // Don't fragment this packet.

  // Supported IP Option Types.
  // These types define the options which may be used in the OptionsData field
  // of the ip_option_information structure. See RFC 791 for a complete
  // description of each.
  IP_OPT_EOL = 0; // End of list option
  IP_OPT_NOP = 1; // No operation
  IP_OPT_SECURITY = $82; // Security option
  IP_OPT_LSRR = $83; // Loose source route
  IP_OPT_SSRR = $89; // Strict source route
  IP_OPT_RR = $7; // Record route
  IP_OPT_TS = $44; // Timestamp
  IP_OPT_SID = $88; // Stream ID (obsolete)

  MAX_OPT_SIZE = 40; // Maximum length of IP options in bytes*)

type
  PIPOptionInformation=^TIPOptionInformation;
  TIPOptionInformation=packed record
    Ttl:byte;			// Время жизни (используется traceroute-ом)
    Tos:byte;			// Тип обслуживания, обычно 0
    Flags : byte;		// Флаги заголовка IP, обычно 0
    OptionsSize: byte;		// Размер данных в заголовке, обычно 0, максимум 40
    OptionsData: Pointer;	// Указатель на данные
  end;

  PIcmpEchoReply=^TIcmpEchoReply;
  TIcmpEchoReply = packed record
    Address:TInAddr; 	   	        // Адрес отвечающего
    Status:Longint;	           	  // IP_STATUS (см. ниже)
    RTTime:Longint;	    	        // Время между эхо-запросом и эхо-ответом в миллисекундах
    DataSize:Word;                // Размер возвращенных данных
    Reserved:Word; 	    	        // Зарезервировано
    Data:Pointer; 		            // Указатель на возвращенные данные
    Options:TIPOptionInformation; // Информация из заголовка IP
  end;

  PIcmpEchoReplyEx=^TIcmpEchoReplyEx;
  TIcmpEchoReplyEx = packed record
    IcmpEchoReply:TIcmpEchoReply;
    RawData:array[0..0] of char;
  end;


function IcmpCreateFile:THandle;stdcall;
function IcmpCloseHandle(IcmpHandle:THandle):LongBool;stdcall;
function IcmpSendEcho(IcmpHandle:THandle;DestAddress:Longint;
    RequestData:Pointer;RequestSize:Word;RequestOptns:PIPOptionInformation;
    ReplyBuffer:pointer;ReplySize:DWORD;Timeout:DWORD):Longint;stdcall;

function FormatIcmpEchoReply(IcmpEchoReply:TIcmpEchoReply):string;
function IcmpEcho(const Address:string;TimeOut:integer=3000;Size:word=16):TIcmpEchoReply;

implementation
const IcmpDLL='ICMP.DLL';

resourcestring
  SSuccess='Ответ от %s: число байт=%d время=%dмс TTL=%d';
  STTL_EXPIRED_TRANSIT='Ответ от %s: Превышен срок жизни (TTL) при передаче пакета.';
  SREQ_TIMED_OUT='Превышен интервал ожидания для запроса.';
  SHOST_UNREACHABLE='Ответ от %s: Узел не доступен';

function IcmpCreateFile; external IcmpDLL name 'IcmpCreateFile';
function IcmpCloseHandle; external IcmpDLL  name 'IcmpCloseHandle';
function IcmpSendEcho; external IcmpDLL name 'IcmpSendEcho';


function FormatIcmpEchoReply(IcmpEchoReply:TIcmpEchoReply):string;
begin
  case IcmpEchoReply.Status of
    IP_SUCCESS: result:=Format(SSuccess,[StrPas(inet_ntoa(IcmpEchoReply.Address)),IcmpEchoReply.DataSize,IcmpEchoReply.RTTime,IcmpEchoReply.Options.Ttl]);
    IP_REQ_TIMED_OUT: result:=SREQ_TIMED_OUT;
    IP_TTL_EXPIRED_TRANSIT: result:=Format(STTL_EXPIRED_TRANSIT,[StrPas(inet_ntoa(IcmpEchoReply.Address))]);
    IP_DEST_HOST_UNREACHABLE: result:=Format(SHOST_UNREACHABLE,[StrPas(inet_ntoa(IcmpEchoReply.Address))]);
  else
    result:=Format('Ответ от %s: код ответа=%d',[StrPas(inet_ntoa(IcmpEchoReply.Address)),IcmpEchoReply.Status]);
  end;
end;

function IcmpEcho(const Address:string;TimeOut:integer=3000;Size:word=16):TIcmpEchoReply;
var
  WSAData:TWSAData;
  Host:longint;
  PIerSize:integer;
  PIer:PIcmpEchoReplyEx;
  hIcmp:THandle;
begin
  if WSAStartup(MakeWord(1,1),WSAData)<>0 then RaiseLastOSError;
  try
    Host:=inet_addr(PChar(Address));
    PIerSize:=sizeof(TIcmpEchoReplyEx)+Size;
    GetMem(PIer,PIerSize);
    try
      FillChar(PIer^.RawData,Size,'0');
      PIer^.IcmpEchoReply.Data:=@PIer^.RawData;
      PIer^.IcmpEchoReply.DataSize:=Size;
      hIcmp:=IcmpCreateFile;
      try
        IcmpSendEcho(hIcmp,Host,@PIer^.RawData,Size,Nil,PIer,PIerSize,TimeOut);
        result:=PIer^.IcmpEchoReply;
      finally
        IcmpCloseHandle(hIcmp);
      end;
    finally
      FreeMem(PIer,PIerSize);
    end;
  finally
    WSACleanup();
  end;
end;

end.

использование
Application.MessageBox(FormatIcmpEc hoReply(IcmpEcho('8.8.8.8')),'',0);