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);