检测是否连上互联网 ( 积分: 100 )

找了不少函数.
我的机器是家里用ADSL上网的,可以解决.但是,我想知道的是,局域网里的机器如何检测.用下面的函数行吗？（这个函数我在家里是可以的）
uses winInet;
function GetOnlineStatus : Boolean;
var ConTypes : Integer;
begin
ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
if (InternetGetConnectedState(@ConTypes, 0) = False) then Result := False
else Result := True;
end;

找了不少函数.
我的机器是家里用ADSL上网的,可以解决.但是,我想知道的是,局域网里的机器如何检测.用下面的函数行吗？（这个函数我在家里是可以的）
uses winInet;
function GetOnlineStatus : Boolean;
var ConTypes : Integer;
begin
ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
if (InternetGetConnectedState(@ConTypes, 0) = False) then Result := False
else Result := True;
end;

局域网内是不行的，比如是通过网关上网的。不过可以Ping某一个固定的Internet上的IP来监测

ping
找几个常用的网站google、baidu连续ping几个，如果都ping不通就认为断了。
我的一个朋友就是这么作的。

delphi中怎么ping呀？
我初学delphi 对delphi了解甚少

谢谢诸位，突然想到一怪招，似乎可以解决我的问题。
再看看。
明天放分。

自己用的一个Ping控件

unit fgNet;

interface

uses
Windows, SysUtils, Classes, Forms, WinSock, WinInet;

type
PIPOptionInfomation=^TIPOptionInfomation;
TIPOptionInfomation=packed record
TTL:byte; //Time to Live 发送数据成活期(最大跳转网关数目)
TOS:byte; //服务类型
Flags:byte;
OptionsSize:byte;
OptionsDataChar;
end;

PIcmpEchoReply=^TIcmpEchoReply;
TIcmpEchoReply=packed record
AddressWORD;
StatusWORD;
RTTWORD;
DataSize:Word;
Reserved:Word;
Dataointer;
Options:TIPOptionInfomation;
end;

TIcmpCreateFile=function:THandle; stdcall;
TIcmpCloseHandle=function(IcmpHandle:THandle):boolean; stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
DestinationAddressWORD;
RequestDataointer;
RequestSize:Word;
RequestOptionsIPOptionInfomation;
ReplyBufferointer;
ReplySizeWORD;
TimeoutWORD)WORD; stdcall;
TfgOnPing=procedure(Succ:boolean;IP:string;Bytes:Word;TimsWORD;TTL:Byte) of Object; //OnPing事件类
TfgOnPingStatus=procedure(Status:string) of Object; //Ping状态事件

{ Ping 控件 }
TfgPing=class(TComponent)
private
hIcmpDll:HMODULE;
f_CheckStr:string;
f_TTL:byte;
f_Status:string;
f_PingStatus:TfgOnPingStatus;
f_IP:string;
f_Host:string;
f_TimeoutWORD;
f_OnPing:TfgOnPing;
f_Pinging:boolean;
hICMP:THandle;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
procedure SetStatus(Value:string);
protected
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
function Ping:boolean;
property Status:string read f_Status write SetStatus;
property Pinging:boolean read f_Pinging;
published
property TimeoutWORD read f_Timeout write f_Timeout; //超时时间
property IPAddr:string read f_IP; //目标IP地址
property Host:string read f_host write f_host;
property TTL:byte read f_TTL write f_TTL; //最大跳转网关数目
property CheckStr:string read f_CheckStr write f_CheckStr; //测试字符串
property OnPing:TfgOnPing read f_OnPing write f_OnPing; //Ping事件
property OnStatus:TfgOnPingStatus read f_PingStatus write f_PingStatus; //状态事件
end;


implementation


const
INVALID_IP_ADDRESS= $ffffffff;

function HostName2IP(const HostName:string):longint;
var
RemoteHost : PHostEnt; (* no, don't free it! *)
ip_address: longint;
(*$ifdef ver80 *)
s: string;
(*$else *)
(*$ifopt h- *)
s: string;
(*$endif *)
(*$endif *)
begin //主机名解析为IP地址
ip_address:=INVALID_IP_ADDRESS;
try
if hostname='' then begin (* no host given! *)
Result:=ip_address;
EXIT;
end
else begin
(*@/// ip_address:=Winsock.Inet_Addr(PChar(hostname)); { try a xxx.xxx.xxx.xx first } *)
(*$ifdef ver80 *)
s:=hostname+#0;
ip_address:=Winsock.Inet_Addr(PChar(@s[1])); (* try a xxx.xxx.xxx.xx first *)
(*$else *)
(*$ifopt h- *)
s:=hostname+#0;
ip_address:=Winsock.Inet_Addr(PChar(@s[1])); (* try a xxx.xxx.xxx.xx first *)
(*$else *)
ip_address:=Winsock.Inet_Addr(PChar(hostname)); (* try a xxx.xxx.xxx.xx first *)
(*$endif *)
(*$endif *)
(*@///*)
if ip_address=SOCKET_ERROR then begin
(*@/// RemoteHost:=Winsock.GetHostByName(PChar(hostname)); *)
(*$ifdef ver80 *)
RemoteHost:=Winsock.GetHostByName(PChar(@s[1]));
(*$else *)
(*$ifopt h- *)
RemoteHost:=Winsock.GetHostByName(PChar(@s[1]));
(*$else *)
RemoteHost:=Winsock.GetHostByName(PChar(hostname));
(*$endif *)
(*$endif *)
(*@///000000090C*)
if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then begin
Result:=ip_address;
EXIT; (* host not found *)
end
else
ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
(* use the first address given *)
end;
end;
except
ip_address:=INVALID_IP_ADDRESS;
end;
Result:=ip_address;
end;

function IP2String(IPAddr:longint):string;
begin //IP地址转为字符串值
IPAddr:=winsock.ntohl(IPAddr);
result:= inttostr(IPAddr shr 24)+'.'+
inttostr((IPAddr shr 16) and $ff)+'.'+
inttostr((IPAddr shr 8) and $ff)+'.'+
inttostr(IPAddr and $ff);
end;

//------------------------------------------------------------------------------
{ begin TfgPing对象 }
constructor TfgPing.Create(AOwner:TComponent);
var WSAData:TWSAData;
begin
inherited Create(AOwner);

//2为所需winsock.dll版本号
WSAStartup(2,WSAData);
{ if (WSAStartup(MAKEWORD(2,0),WSAData)<>0) then;
raise Exception.Create('Winsock version error!');}

hIcmpDll:=LoadLibrary('icmp.dll');
if hIcmpDll<>0 then
begin //加载
@ICMPCreateFile:=GetProcAddress(hICMPDll,'IcmpCreateFile');
@IcmpCloseHandle:=GetProcAddress(hICMPDll,'IcmpCloseHandle');
@IcmpSendEcho:=GetProcAddress(hICMPDll,'IcmpSendEcho');
end
else
raise Exception.Create('Load icmp.dll fail!');

hICMP:=IcmpCreateFile;
if hICMP=INVALID_HANDLE_VALUE then
raise Exception.Create('Create ICMP Failed!');

f_Status:='';
f_Timeout:=5000;
f_TTL:=64;
f_Host:='127.0.0.1';
f_CheckStr:='Ping Address';
end;

destructor TfgPing.Destroy;
begin
IcmpCloseHandle(hIcmp);
WSACleanup;
if hIcmpDll<>0 then FreeLibrary(hIcmpDll);
inherited Destroy;
end;

procedure TfgPing.SetStatus(Value:string);
begin
f_Status:=Value;
if Assigned(f_PingStatus) then
f_PingStatus(f_Status);
end;

function TfgPing.Ping:boolean;
var IPOpt:TIPOptionInfomation;
FIPAddressWORD;
pReqData,pRevDataChar;
pIPEIcmpEchoReply;
FSizeWORD;
MyString:string;
BufferSizeWORD;
temp:integer;
begin
Result:=false;
if f_Pinging then exit;
f_host:=Trim(f_host);
if f_host='' then raise Exception.Create('IP Empty!');

FIPAddress:=HostName2IP(f_host); //获取实际地址
f_IP:=IP2String(FIPAddress); //解析主机名为IP

if FIPAddress=INADDR_NONE then
begin
//raise Exception.Create('Invalid IP Address!');
OnPing(false,'',0,0,0);
exit;
end;

Status:='Ping……';

//计算包大小
FSize:=40;
BufferSize:=SizeOf(TICMPEchoReply)+FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);

//数据准备
FillChar(pIPE^,SizeOf(pIPE^),0);
pIPE^.Data:=pRevData;
MyString:=f_CheckStr;
pReqData:=PChar(MyString);
FillChar(IPOpt,SizeOf(IPOpt),0);
IPOpt.TTL:=f_TTL;

f_Pinging:=true;
try
temp:=IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),@IPOpt,pIPE,BufferSize,f_Timeout);
finally
f_Pinging:=false;
end;
try
if temp=0 then
begin
Status:='Failure!';
OnPing(false,f_IP,0,0,0);
end
else
begin
if pReqData^=pIPE^.Options.OptionsData^ then
begin
if Assigned(OnPing) then
begin
Status:='Success!';
OnPing(true,f_IP,pIPE^.DataSize,pIPE^.RTT,pIPE^.Options.TTL);
Result:=true;
end;
end;
end;
finally
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
{ end TfgPing对象 }
//------------------------------------------------------------------------------

end.

{=================================================================
功 能: 檢測計算機是否上網
參 數: 無
返回值: 成功: True 失敗: False;
=================================================================}
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;

to bbscom,你的执行有问题：
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
提示找不到InternetGetConnectedState

要引入單元：
uses WinInet;

check if I am connected to the internet ?

interface
uses
Windows, SysUtils, Registry, WinSock, WinInet;

type
TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;


implementation

//For RasConnectionCount =======================
const
cERROR_BUFFER_TOO_SMALL = 603;
cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128;
cRAS_MaxDeviceType = 16;
type
ERasError = class(Exception);

HRASConn = DWord;
PRASConn = ^TRASConn;
TRASConn = record
dwSize: DWORD;
rasConn: HRASConn;
szEntryName: Array[0..cRAS_MaxEntryName] Of Char;
szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char;
szDeviceName : Array [0..cRAS_MaxDeviceName] of char;
end;

TRasEnumConnections =
function (RASConn: PrasConn; { buffer to receive Connections data }
var BufSize: DWord; { size in bytes of buffer }
var Connections: DWord { number of Connections written to buffer }
): LongInt; stdcall;
//End RasConnectionCount =======================


function ConnectedToInternet: TConnectionType;
var
Reg : TRegistry;
bUseProxy : Boolean;
UseProxy : LongWord;
begin
Result := ctNone;
Reg := TRegistry.Create;
with REG do
try
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('/Software/Microsoft/Windows/CurrentVersion/Internet settings',False) then begin
//I just try to read it, and trap an exception
if GetDataType('ProxyEnable') = rdBinary then
ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
else begin
bUseProxy := ReadBool('ProxyEnable');
if bUseProxy then
UseProxy := 1
else
UseProxy := 0;
end;
if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result := ctProxy;
end;
except
//Obviously not connected through a proxy
end;
finally
Free;
end;

//We can check RasConnectionCount even if dialup networking is not installed
//simply because it will return 0 if the DLL is not found.
if Result = ctNone then begin
if RasConnectionCount > 0 then Result := ctDialup;
end;
end;

function RasConnectionCount : Integer;
var
RasDLL : HInst;
Conns : Array[1..4] of TRasConn;
RasEnums : TRasEnumConnections;
BufSize : DWord;
NumConns : DWord;
RasResult : Longint;
begin
Result := 0;

//Load the RAS DLL
RasDLL := LoadLibrary('rasapi32.dll');
if RasDLL = 0 then exit;

try
RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
if @RasEnums = nil then
raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');

Conns[1].dwSize := Sizeof (Conns[1]);
BufSize := SizeOf(Conns);

RasResult := RasEnums(@Conns, BufSize, NumConns);

If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns;
finally
FreeLibrary(RasDLL);
end;
end;

据说有的局域网里禁止ping.
上面bbscom和Beyondbill的函数,没有说明是否可以检测局域网里的机器,而我家里的电脑又不能测试.
请说明一下好吗？

对不起,我刚才注意看了一下,bbscom的函数里有注释,可以检测局域网里的机器

发分了.
谢谢大家.