=================================================================
功 能: 检测网络状态
参 数:
IpAddr: 被测试网络上主机的IP地址或名称，建议使用Ip
返回值: 成功: True 失败: False;
备 注:
版 本:
1.0 2002/10/03 09:40:00
=================================================================}
function CheckNet(IpAddr: string): Boolean;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
// Time To Live (used for traceroute)
TOS: Byte;
// Type Of Service (usually 0)
Flags: Byte;
// IP header flags (usually 0)
OptionsSize: Byte;
// Size of options data (usually 0, max 40)
OptionsData: PChar;
// Options data buffer
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWord;
// replying address
Status: DWord;
// IP status value (see below)
RTT: DWord;
// Round Trip Time in milliseconds
DataSize: Word;
// reply data size
Reserved: Word;
Data: Pointer;
// pointer to reply data buffer
Options: TIPOptionInformation;
// reply options
end;
TIcmpCreateFile = function: THandle;
stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean;
stdcall;
TIcmpSendEcho = function(
IcmpHandle: THandle;
DestinationAddress: DWord;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord;
stdcall;
const
Size = 32;
TimeOut = 1000;
var
wsadata: TWSAData;
Address: DWord;
// Address of host to contact
HostName, HostIP: string;
// Name anddo
tted IP of host to contact
Phe: PHostEnt;
// HostEntry buffer for name lookup
BufferSize, nPkts: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply;
// ICMP Echo reply buffer
IPOpt: TIPOptionInformation;
// IP Options for packet to send
const
IcmpDLL = 'icmp.dll';
var
hICMPlib: HModule;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle;
// Handle for the ICMP Calls
begin
// initialise winsock
Result := True;
if WSAStartup(2, wsadata) <> 0 then
begin
Result := False;
halt;
end;
// register the icmp.dll stuff
hICMPlib := loadlibrary(icmpDLL);
if hICMPlib <> 0 then
begin
@ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPlib, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPlib, 'IcmpSendEcho');
if (@ICMPCreateFile = nil) or (@IcmpCloseHandle = nil) or (@IcmpSendEcho = nil) then
begin
Result := False;
halt;
end;
hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then
begin
Result := False;
halt;
end;
end else
begin
Result := False;
halt;
end;
// ------------------------------------------------------------
Address := inet_addr(PChar(IpAddr));
if (Address = INADDR_NONE) then
begin
Phe := GetHostByName(PChar(IpAddr));
if Phe = nil then
Result := False
else
begin
Address := longint(plongint(Phe^.h_addr_list^)^);
HostName := Phe^.h_name;
HostIP := StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else
begin
Phe := GetHostByAddr(@Address, 4, PF_INET);
if Phe = nil then
Result := False;
end;
if Address = INADDR_NONE then
begin
Result := False;
end;
// Get some data buffer space and put something in the packet to send
BufferSize := SizeOf(TICMPEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);
FillChar(pReqData^, Size, $AA);
pIPE^.Data := pData;
// Finally Send the packet
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := 64;
NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
@IPOpt, pIPE, BufferSize, TimeOut);
if NPkts = 0 then
Result := False;
// Free those buffers
FreeMem(pIPE);
FreeMem(pData);
FreeMem(pReqData);
// --------------------------------------------------------------
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then
Result := False;
end;
