德尔福:在单独的线程中检查互联网连接

Question

在我的表单中，当 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 任务管理器中，分析等待链向我显示另一个待处理的线程，这次如果互联网出现故障，我的应用程序没有反应！

怎么了？？ 求求你，帮帮我！ 谢谢！ 伊曼纽尔

Answer 1

TThread构造函数在调用它的线程中运行，在您的情况下，该线程是主 UI 线程。您在工作线程中运行的唯一内容是Synchronize()，它在主 UI 线程中运行其代码，完全违背了使用工作线程的目的。

您需要将 TCP 连接/断开连接逻辑从构造函数移动到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;