Delphi: 在单独的线程中检查互联网连接
Delphi: check internet connection in a separated thread
在我的表单中,当 Ontimer 事件发生时,会创建一个新线程来检查互联网连接是否处于活动状态。
这是我的代码:
type
TMain = class(TForm)
...
...
TThread_Check = class(TThread)
private
TCPClient : TIdTCPClient;
procedure InternetCheck;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
end;
var Main: TMain;
Internet, THRD_RUNNING: Boolean;
OGGI: TDate;
...
...
constructor TThread_Check.Create;
begin
inherited Create(True);
TCPClient := TIdTCPClient.Create (NIL);
try
try
TCPClient.ReadTimeout := 2000;
TCPClient.ConnectTimeout := 2000;
TCPClient.Port := 80;
TCPClient.Host := 'google.com';
TCPClient.Connect;
TCPClient.Disconnect;
INTERNET:= true;
except
INTERNET:= False;
end;
finally
TCPClient.Free;
end;
end;
procedure TThread_Check.Execute;
begin
Synchronize(InternetCheck);
end;
destructor TThread_Check.Destroy;
begin
THRD_RUNNING:=false;
end;
procedure TThread_Check.InternetCheck;
begin
if INTERNET then
begin
main.idt.Active:=true;
OGGI:=main.idt.DateTime; // Pick internet Date ad assign to OGGI
main.idt.Active:=false;
end;
end;
procedure TMain.OnTimerEvent(Sender: TObject);
Var THD : TThread_Check;
begin
if (THRD_RUNNING = False) then
begin
THRD_RUNNING := True;
thd := TThread_Check.Create;
thd.FreeOnTerminate := true;
thd.Priority := tpNormal;
Thd.Resume;
end;
end;
procedure TMain.OnCreate(Sender: TObject);
begin
THRD_RUNNING:=false;
end;
最初它似乎有效;我的应用程序启动,如果互联网出现故障,它会注意到(在主窗体中,如果 INTERNET=false 发生某些事情...)。
问题是应用程序激活一段时间后冻结,在 Windows 任务管理器中,分析等待链显示另一个线程挂起,这次如果互联网中断我的应用程序不会做出反应!
有什么问题??
请帮我!
谢谢!
伊曼纽尔
TThread
构造函数在调用它的线程中运行,在您的例子中是主 UI 线程。你在你的工作线程中唯一 运行 是 Synchronize()
,它在主 UI 线程中运行它的代码,完全违背了使用工作线程的目的。
您需要将 TCP connect/disconnect 逻辑从构造函数移至 Execute
。使用 Synchronize()
仅更新 UI。在这种情况下,您可以只使用 OnTerminate
事件,它已经为您同步了。
例如:
type
TMain = class(TForm)
...
end;
TThread_Check = class(TThread)
private
TCPClient : TIdTCPClient;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
end;
var
Main: TMain;
Internet, THRD_RUNNING: Boolean;
OGGI: TDate;
...
constructor TThread_Check.Create;
begin
inherited Create(True);
TCPClient := TIdTCPClient.Create (NIL);
TCPClient.ReadTimeout := 2000;
TCPClient.ConnectTimeout := 2000;
TCPClient.Port := 80;
TCPClient.Host := 'google.com';
end;
procedure TThread_Check.Execute;
begin
try
TCPClient.Connect;
TCPClient.Disconnect;
INTERNET := True;
except
INTERNET := False;
end;
end;
destructor TThread_Check.Destroy;
begin
TCPClient.Free;
inherited;
end;
procedure TMain.OnInternetCheckDone(Sender: TObject);
begin
THRD_RUNNING := False;
if INTERNET then
begin
Main.idt.Active := true;
OGGI := Main.idt.DateTime;
Main.idt.Active := false;
end;
end;
procedure TMain.OnTimerEvent(Sender: TObject);
var
THD : TThread_Check;
begin
if (not THRD_RUNNING) then
begin
thd := TThread_Check.Create;
thd.FreeOnTerminate := True;
thd.OnTerminate := OnInternetCheckDone;
Thd.Resume;
THRD_RUNNING := True;
end;
end;
procedure TMain.OnCreate(Sender: TObject);
begin
THRD_RUNNING := False;
end;
在我的表单中,当 Ontimer 事件发生时,会创建一个新线程来检查互联网连接是否处于活动状态。 这是我的代码:
type
TMain = class(TForm)
...
...
TThread_Check = class(TThread)
private
TCPClient : TIdTCPClient;
procedure InternetCheck;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
end;
var Main: TMain;
Internet, THRD_RUNNING: Boolean;
OGGI: TDate;
...
...
constructor TThread_Check.Create;
begin
inherited Create(True);
TCPClient := TIdTCPClient.Create (NIL);
try
try
TCPClient.ReadTimeout := 2000;
TCPClient.ConnectTimeout := 2000;
TCPClient.Port := 80;
TCPClient.Host := 'google.com';
TCPClient.Connect;
TCPClient.Disconnect;
INTERNET:= true;
except
INTERNET:= False;
end;
finally
TCPClient.Free;
end;
end;
procedure TThread_Check.Execute;
begin
Synchronize(InternetCheck);
end;
destructor TThread_Check.Destroy;
begin
THRD_RUNNING:=false;
end;
procedure TThread_Check.InternetCheck;
begin
if INTERNET then
begin
main.idt.Active:=true;
OGGI:=main.idt.DateTime; // Pick internet Date ad assign to OGGI
main.idt.Active:=false;
end;
end;
procedure TMain.OnTimerEvent(Sender: TObject);
Var THD : TThread_Check;
begin
if (THRD_RUNNING = False) then
begin
THRD_RUNNING := True;
thd := TThread_Check.Create;
thd.FreeOnTerminate := true;
thd.Priority := tpNormal;
Thd.Resume;
end;
end;
procedure TMain.OnCreate(Sender: TObject);
begin
THRD_RUNNING:=false;
end;
最初它似乎有效;我的应用程序启动,如果互联网出现故障,它会注意到(在主窗体中,如果 INTERNET=false 发生某些事情...)。
问题是应用程序激活一段时间后冻结,在 Windows 任务管理器中,分析等待链显示另一个线程挂起,这次如果互联网中断我的应用程序不会做出反应!
有什么问题?? 请帮我! 谢谢! 伊曼纽尔
TThread
构造函数在调用它的线程中运行,在您的例子中是主 UI 线程。你在你的工作线程中唯一 运行 是 Synchronize()
,它在主 UI 线程中运行它的代码,完全违背了使用工作线程的目的。
您需要将 TCP connect/disconnect 逻辑从构造函数移至 Execute
。使用 Synchronize()
仅更新 UI。在这种情况下,您可以只使用 OnTerminate
事件,它已经为您同步了。
例如:
type
TMain = class(TForm)
...
end;
TThread_Check = class(TThread)
private
TCPClient : TIdTCPClient;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
end;
var
Main: TMain;
Internet, THRD_RUNNING: Boolean;
OGGI: TDate;
...
constructor TThread_Check.Create;
begin
inherited Create(True);
TCPClient := TIdTCPClient.Create (NIL);
TCPClient.ReadTimeout := 2000;
TCPClient.ConnectTimeout := 2000;
TCPClient.Port := 80;
TCPClient.Host := 'google.com';
end;
procedure TThread_Check.Execute;
begin
try
TCPClient.Connect;
TCPClient.Disconnect;
INTERNET := True;
except
INTERNET := False;
end;
end;
destructor TThread_Check.Destroy;
begin
TCPClient.Free;
inherited;
end;
procedure TMain.OnInternetCheckDone(Sender: TObject);
begin
THRD_RUNNING := False;
if INTERNET then
begin
Main.idt.Active := true;
OGGI := Main.idt.DateTime;
Main.idt.Active := false;
end;
end;
procedure TMain.OnTimerEvent(Sender: TObject);
var
THD : TThread_Check;
begin
if (not THRD_RUNNING) then
begin
thd := TThread_Check.Create;
thd.FreeOnTerminate := True;
thd.OnTerminate := OnInternetCheckDone;
Thd.Resume;
THRD_RUNNING := True;
end;
end;
procedure TMain.OnCreate(Sender: TObject);
begin
THRD_RUNNING := False;
end;