I ping the location:
Usage:
bPingSuccess := Ping(szServer, 5000);
unit uPing;
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;
TIcmpCreateFile = function(): THandle; stdcall;
TIcmpCloseHandle = function(icmpHandle: THandle): boolean; stdcall;
TIcmpSendEcho = function(IcmpHandle: THandle; DestinationAddress: IPAddr; RequestData:
Pointer; RequestSize: smallint; RequestOptions: pointer; ReplyBuffer: Pointer;
ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;
const
IcmpCreateFile: TIcmpCreateFile = nil;
IcmpCloseHandle: TIcmpCloseHandle = nil;
IcmpSendEcho: TIcmpSendEcho = nil;
function Ping(InetAddress: string; iTimeout: cardinal): boolean;
implementation
uses
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) 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; iTimeout: cardinal): boolean;
var
hIcmpDll: HMODULE;
hIcmpFile: THandle;
InAddr: IPAddr;
DW: DWORD;
rep: array[1..128] of byte;
begin
Result := False;
{ load a library }
hIcmpDll := LoadLibrary('icmp.dll');
if (hIcmpDll = 0) then
begin
raise Exception.Create('icmp.dll library can not be loaded or not found. ' +
SysErrorMessage(GetLastError));
end;
try
{ load an address of required procedure}
@IcmpCreateFile := GetProcAddress(hIcmpDll, 'IcmpCreateFile');
@IcmpSendEcho := GetProcAddress(hIcmpDll, 'IcmpSendEcho');
@IcmpCloseHandle := GetProcAddress(hIcmpDll, 'IcmpCloseHandle');
{if procedure is found in the dll}
if Assigned(IcmpCreateFile) and Assigned(IcmpSendEcho) and Assigned(IcmpCloseHandle)
then
begin
hIcmpFile := IcmpCreateFile;
try
if hIcmpFile = INVALID_HANDLE_VALUE then
Exit;
TranslateStringToTInAddr(InetAddress, InAddr);
DW := IcmpSendEcho(hIcmpFile, InAddr, nil, 0, nil, @rep, 128, iTimeout); //0);
Result := (DW <> 0);
finally
IcmpCloseHandle(hIcmpFile);
end;
end;
finally
{unload a library}
FreeLibrary(hIcmpDll);
end;
end;
end.