unit hostalive;
interface
function IsHostAlive(Hostname:
String; pTripTime: PCardinal =
nil; Timeout: Integer = 1000; TTL: Integer = 255): Boolean;
implementation
uses
Windows,
Winsock;
type
TForm11 =
class(TForm)
IP_OPTION_INFORMATION =
packed record
TTL: byte;
TOS: byte;
Flags: byte;
OptionsSize: byte;
OptionsData: pchar;
end;
PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
ICMP_ECHO_REPLY =
packed record
Address: in_addr;
Status: Cardinal;
RoundTripTime: Cardinal;
DataSize: word;
Reserved: word;
Data: pointer;
Options: IP_OPTION_INFORMATION;
end;
PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
function IcmpCreateFile(): Cardinal;
stdcall;
external '
Iphlpapi.dll'
name '
IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle: Cardinal): Boolean;
stdcall;
external '
Iphlpapi.dll'
name '
IcmpCloseHandle';
function IcmpSendEcho(IcmpHandle: Cardinal; DestinationAddress: Cardinal; RequestData: Pointer; RequestSize: Word; RequestOptions: PIP_OPTION_INFORMATION; ReplyBuffer: Pointer; ReplySize: Cardinal; Timeout: Cardinal): Cardinal;
stdcall;
external '
Iphlpapi.dll'
name '
IcmpSendEcho';
function IsHostAlive(Hostname:
String; pTripTime: PCardinal =
nil; Timeout: Integer = 1000; TTL: Integer = 255): Boolean;
const
SendBuffer:
array[0..31]
of char =
('
p', '
i', '
n', '
g', '
p', '
o', '
n', '
g',
'
p', '
i', '
n', '
g', '
p', '
o', '
n', '
g',
'
p', '
i', '
n', '
g', '
p', '
o', '
n', '
g',
'
p', '
i', '
n', '
g', '
p', '
o', '
n', '
g');
var
WSA: TWSADATA;
Reply: PICMP_ECHO_REPLY;
Addr: Integer;
hIcmp: cardinal;
Options: IP_OPTION_INFORMATION;
function ResolveHost(Hostname:
String): Integer;
type
PPInAddr= ^PInAddr;
var
HostInfo: PHostEnt;
T: PPInAddr;
begin
t:=
nil;
Result:= inet_addr(PChar(Hostname));
if result = INADDR_NONE
then begin
HostInfo:= gethostbyname(PChar(Hostname));
if HostInfo <>
nil then
T:= Pointer(HostInfo^.h_addr_list);
if (T <>
nil)
and (T^<>
nil)
then begin
Result:= T^^.S_addr;
end;
end;
end;
begin
Result:= False;
FillChar(Options, sizeof(IP_OPTION_INFORMATION), #0);
Reply:=
nil;
options.TTL:= TTL;
options.TOS:= 1;
if WSAStartUp(((0
shl 8)+2), WSA) = 0
then begin
Addr:= ResolveHost(Hostname);
if Addr <> INADDR_NONE
then begin
hIcmp:= IcmpCreateFile();
if hicmp <> INVALID_HANDLE_VALUE
then try
Reply:= AllocMem(sizeof(ICMP_ECHO_REPLY)+sizeof(SendBuffer));
IcmpSendEcho(hIcmp, Addr, @SendBuffer[0], sizeof(SendBuffer), @Options, Reply, sizeof(ICMP_ECHO_REPLY)+sizeof(SendBuffer), timeout);
Result:= (Reply^.Status = 0);
if Result
and (pTripTime <>
nil)
then
pTripTime^:= Reply^.RoundTripTime;
finally
IcmpCloseHandle(hIcmp);
if Reply <>
nil then
FreeMem(Reply, sizeof(ICMP_ECHO_REPLY)+8);
WSACleanup();
end;
end else begin
WSACleanup();
// Hostname konnte nicht aufgelöst werden.
end;
end else begin
// Winsock konnte nicht gestartet werden.
end;
end;
end.