为方便网络编程的朋友给自己的程序获得洞查 internet 的连接与否状态，以便为自动运行提供指示。QQ 不知道为什么没有使用这个函数，而 MSN 、ICQ却早就在使用了。这个片段中，还是自己简单地声明了几个 Delphi 中没有函数和常量。
{***************************************************************
* Unit Name: Unit1
* Purpose : 象 MSN 一样检测网络是否连入 internet .
* Author : 小雨哥
* History : 启动后如果连接和退出 internet 都会提示
****************************************************************}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
RASCN_Connection=1;
RASCN_Disconnection=2;
type
TForm1 = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
procedure DiscOver(Sender: TObject);
procedure ConnOver(Sender: TObject);
procedure bntClose(Sender: TObject);
public
end;
TConnectCheckThread = class(TThread)
protected
procedure Execute; override;
end;
TDisconnectCheckThread = class(TThread)
protected
procedure Execute; override;
end;
function RasConnectionNotification(HAND:THANDLE;hEvent:THANDLE;dwFlags:DWORD):integer;stdcall;
function GetOnlineStatus : Boolean;
function WaitForConnectCheck:Boolean;
function WaitForDisconnectCheck:Boolean;
var
Form1: TForm1;
implementation
uses WinInet;
{$R *.DFM}
function RasConnectionNotification; external RasAPI32.dll name RasConnectionNotificationA;
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;
function WaitForConnectCheck:Boolean;
var
SecuAttr:TSecurityAttributes;
hConnected:THANDLE;
Res:DWord;
begin
SecuAttr.nLength := SizeOf(SecuAttr);
SecuAttr.bInheritHandle:=False;
SecuAttr.lpSecurityDescriptor :=nil;
hConnected:=CreateEvent(@SecuAttr,True, False, Connect);
try
Res:=RasConnectionNotification(INVALID_HANDLE_VALUE,hConnected,RASCN_Connection);
if Res=0 then
begin
WaitForSingleObject(hConnected, INFINITE);
MessageBox(0,检测到本机已经连入 Internet ！,信息,MB_OK);
end
else MessageBox(0,Res<>0,信息,MB_OK);
finally
ResetEvent(hConnected);
Result := True;
end;
end;
function WaitForDisconnectCheck:Boolean;
var
SecuAttr:TSecurityAttributes;
hTerminated:THANDLE;
Res:DWord;
begin
SecuAttr.nLength := SizeOf(SecuAttr);
SecuAttr.bInheritHandle:=False;
SecuAttr.lpSecurityDescriptor :=nil;
hTerminated:=CreateEvent(@SecuAttr,True, False, Disconnect);
try
Res:=RasConnectionNotification(INVALID_HANDLE_VALUE,hTerminated,RASCN_Disconnection);
if Res=0 then
begin
WaitForSingleObject(hTerminated, INFINITE);
MessageBox(0,检测到本机已经关闭了 Internet 连接！,信息,MB_OK);
end
else MessageBox(0,Res<>0,信息,MB_OK);
finally
ResetEvent(hTerminated);
Result := True;
end;
end;
procedure TForm1.bntClose(Sender: TObject);
begin
Close;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
CC:TConnectCheckThread;
DC:TDisconnectCheckThread;
begin
if GetOnlineStatus then
begin
DC:=TDisconnectCheckThread.Create(True);
DC.FreeOnTerminate :=True;
DC.Priority:=tpLower;
DC.OnTerminate:=DiscOver;
DC.Resume;
end
else
begin
CC:=TConnectCheckThread.Create(True);
CC.FreeOnTerminate :=True;
CC.Priority:=tpLower;
CC.OnTerminate :=ConnOver;
CC.Resume;
end;
SendMessage(Handle,WM_SysCommand,SC_Minimize,0);
Button1.OnClick:=bntClose;
Button1.Caption:=关闭;
end;
procedure TConnectCheckThread.Execute;
begin
WaitForConnectCheck;
end;
procedure TDisconnectCheckThread.Execute;
begin
WaitForDisconnectCheck;
end;
procedure TForm1.ConnOver(Sender: TObject);
var
DC:TDisconnectCheckThread;
begin
if CheckBox1.Checked then
begin
DC:=TDisconnectCheckThread.Create(True);
DC.FreeOnTerminate :=True;
DC.Priority:=tpLower;
DC.OnTerminate:=DiscOver;
DC.Resume;
end;
end;
procedure TForm1.DiscOver(Sender: TObject);
var
CC:TConnectCheckThread;
begin
if CheckBox1.Checked then
begin
CC:=TConnectCheckThread.Create(True);
CC.FreeOnTerminate :=True;
CC.Priority:=tpLower;
CC.OnTerminate :=ConnOver;
CC.Resume;
end;
end;
end.
这个代码实现了一个循环，正式使用可以根据自己的程序取舍。
