{=================================================================
功 能: 检测网络状态
参 数:
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 and dotted 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 <> null 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;
{=================================================================
功 能: 检测计算机是否上网
参 数: 无
返回值: 成功: True 失败: False;
备 注: uses Wininet
版 本:
1.0 2002/10/07 13:33:00
=================================================================}
function InternetConnected: Boolean;
const
// local system uses a modem to connect to the Internet.
INTERNET_CONNECTION_MODEM = 1;
// local system uses a local area network to connect to the Internet.
INTERNET_CONNECTION_LAN = 2;
// local system uses a proxy server to connect to the Internet.
INTERNET_CONNECTION_PROXY = 4;
// local system's modem is busy with a non-Internet connection.
INTERNET_CONNECTION_MODEM_BUSY = 8;
var
dwConnectionTypes : DWORD;
begin
dwConnectionTypes := INTERNET_CONNECTION_MODEM+
INTERNET_CONNECTION_LAN
+ INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;
//关闭网络连接
function NetCloseAll:boolean;
const
NETBUFF_SIZE=$208;
type
NET_API_STATUS=DWORD;
LPByte=PByte;
var
dwNetRet :DWORD;
i :integer;
dwEntries :DWORD;
dwTotalEntries :DWORD;
szClient :LPWSTR;
dwUserName :DWORD;
Buff :array[0..NETBUFF_SIZE-1]of byte;
Adword :array[0..NETBUFF_SIZE div 4-1] of dword;
NetSessionEnum:function ( ServerName:LPSTR;
Reserved:DWORD;
Buf:LPByte;
BufLen:DWORD;
ConnectionCount:LPDWORD;
ConnectionToltalCount:LPDWORD
):NET_API_STATUS;
stdcall;
NetSessionDel:function ( ServerName:LPWSTR;
UncClientName: LPWSTR ;
UserName: dword):NET_API_STATUS;
stdcall;
LibHandle : THandle;
begin
Result:=false;
try
{ 加载 DLL }
LibHandle := LoadLibrary('svrapi.dll');
try
{ 如果加载失败，LibHandle = 0.}
if LibHandle = 0 then
raise Exception.Create('不能加载SVRAPI.DLL');
{ DLL 加载成功，取得到 DLL
输出函数的连接然后调用 }
@NetSessionEnum := GetProcAddress(LibHandle, 'NetSessionEnum');
@NetSessionDel := GetProcAddress(LibHandle, 'NetSessionDel');
if (@NetSessionEnum = nil)or(@NetSessionDel=nil) then
RaiseLastWin32Error { 连接函数失败 }
else
begin
dwNetRet := NetSessionEnum( nil,$32, @Buff,
NETBUFF_SIZE, @dwEntries,
@dwTotalEntries );
if dwNetRet = 0 then
begin
Result := true;
for i:=0 to dwTotalEntries-1 do
begin
Move(Buff,Adword,NETBUFF_SIZE);
szClient:=LPWSTR(Adword[0]);
dwUserName := Adword[2];
dwNetRet := NetSessionDel( nil,szClient,dwUserName);
if( dwNetRet <> 0 ) then
begin
Result := false;
break;
end;
Move(Buff[26],Buff[0],NETBUFF_SIZE-(i+1)*26);
end
end
else
Result := false;
end;
finally
FreeLibrary(LibHandle); // Unload the DLL.
end;
except
end;
end;
end.
这个unit的下载请自找．
