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;