delphi 线程无限等待（永不终止）

Question

我正在等待线程完成，但没有成功，它卡在了 WaitFor() 方法中；而且不会 return，无限期地站在那里。

procedure TForm1.btnStopClick(Sender: TObject);

谁能帮帮我？

我正在 Delphi Berlin 10.1 Update 2 运行 Windows 10 64 位版本 1709 16299.64

遵循代码：

unit untPrincipal;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const
   WM_TEST_SERVICE = WM_APP + 1;

type
   TForm1 = class(TForm)
      btnStart: TButton;
      mmoOutput: TMemo;
      btnStop: TButton;
      procedure btnStartClick(Sender: TObject);
      procedure btnStopClick(Sender: TObject);
   private
      { Private declarations }
      threadService: TThread;
      procedure OnThreadTerminate(Sender: TObject);
      procedure WMTestService(var msg: TMessage); message WM_TEST_SERVICE;
   public
      { Public declarations }
   end;

   IThreadInfo = interface
      ['{B179712B-8B14-4D54-86DA-AB22227DBCAA}']
      function IsRunning: Boolean;
   end;

   IService = interface
      ['{30934A11-1FB9-46CB-8403-F66317B50199}']
      procedure ServiceCreate();
      procedure ServiceStart(const info: IThreadInfo);
   end;

   TMyService = class(TInterfacedObject, IService)
   private
      handle: THandle;
   public
      constructor Create(const handle: THandle);
      procedure ServiceCreate;
      procedure ServiceStart(const info: IThreadInfo);
   end;

   TThreadService = class(TThread)
   private
      service: IService;
   protected
      procedure Execute; override;
   public
      constructor Create(const service: IService);
   end;

   TThreadInfo = class(TInterfacedObject, IThreadInfo)
   private
      thread: TThread;
   public
      constructor Create(const thread: TThread);
      function IsRunning: Boolean;
   end;

   TThreadPost = class(TThread)
   private
      handle: THandle;
      info: IThreadInfo;
   protected
      procedure Execute; override;
   public
      constructor Create(const handle: THandle; const info: IThreadInfo);
   end;

var
   Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.btnStartClick(Sender: TObject);
var
   service: IService;
begin
   service := TMyService.Create(Self.handle);
   threadService := TThreadService.Create(service);
   threadService.OnTerminate := OnThreadTerminate;
   threadService.Start;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
   if Assigned(threadService) then
   begin
      try
         threadService.Terminate;
         threadService.WaitFor;
      finally
         if Assigned(threadService) then
            FreeAndNil(threadService);
      end;
   end;
end;

procedure TForm1.OnThreadTerminate(Sender: TObject);
begin
   mmoOutput.Lines.Add(DateTimeToStr(Now()) + ' - procedure TForm1.OnThreadTerminate(Sender: TObject);');
end;

procedure TForm1.WMTestService(var msg: TMessage);
begin
   mmoOutput.Lines.Add(DateTimeToStr(Now()) + ' - Service');
end;

{ TMyService }

constructor TMyService.Create(const handle: THandle);
begin
   inherited Create();
   Self.handle := handle;
end;

procedure TMyService.ServiceCreate;
begin
   PostMessage(handle, WM_TEST_SERVICE, 0, 0);
end;

procedure TMyService.ServiceStart(const info: IThreadInfo);
var
   thread: TThreadPost;
begin
   while info.IsRunning do
   begin
      thread := TThreadPost.Create(handle, info);
      try
         thread.Start;
         thread.WaitFor;
         ShowMessage('Never Execute');
      finally
         thread.Free;
      end;
   end;
end;

{ TThreadService }

constructor TThreadService.Create(const service: IService);
begin
   inherited Create(True);
   Self.service := service;
end;

procedure TThreadService.Execute;
begin
   service.ServiceCreate;
   service.ServiceStart(TThreadInfo.Create(Self) as IThreadInfo);
end;

{ TThreadInfo }

constructor TThreadInfo.Create(const thread: TThread);
begin
   inherited Create();
   Self.thread := thread;
end;

function TThreadInfo.IsRunning: Boolean;
begin
   Result := not thread.CheckTerminated;
end;

{ TThreadPost }

constructor TThreadPost.Create(const handle: THandle; const info: IThreadInfo);
begin
   inherited Create(True);
   Self.handle := handle;
   Self.info := info;
end;

procedure TThreadPost.Execute;
begin
   while info.IsRunning do
   begin
      PostMessage(handle, WM_TEST_SERVICE, 0, 0);
      Sleep(1000);
   end;
end;

end.

Answer 1

您正在呼叫：

function TThreadInfo.IsRunning: Boolean;
begin
   Result := not thread.CheckTerminated;
end;

来自 TThreadPost.Execute，它会尝试检查 thread 实例是否已终止。

问题是对 CheckTerminated 的调用使用了当前线程终止状态，而不是 thread 实例。（想想如果 thread 实例在调用 thread.CheckTerminated 时被终止并释放会发生什么，如果可能的话）。

结果是IsRunning永远不会为假，你就会死循环。您将不得不重新设计如何以安全的方式停止线程。

Answer 2

在我们开始任何事情之前，请下次在您的 class 中以 'F'.

开始字段名称

让我们从第一个用户操作开始逐步查看您的代码

procedure TForm1.btnStartClick(Sender: TObject);

service := TMyService.Create(Self.handle);

您创建了 TMyService 的实例并将 TForm.Handle 分配给字段 handle（您应该将其命名为 FHandle）。

threadService := TThreadService.Create(service);

您创建了一个 TThread 的挂起实例并将 service 分配给它的私有字段 service（同样您应该将其命名为 FService 并且您不需要使用自我）

有一点是这次保留了引用，这与第一行的引用 dies/lost 位于作用域末尾不同。

threadService.OnTerminate := OnThreadTerminate;

分配 Onterminate 事件处理程序。

Onterminate 在内部使用 synchronize()，因此这可能是死锁的原因。（<--- 未来容易出错的一个）

threadService.Start;

你开始暂停threadService.

此时你有两个线程运行 MainThread 和 threadService（MyService 在 MainThread 的上下文中运行）。

MainThread 空闲等待更多用户操作或处理其他消息（即：重新绘制、调整大小、移动表单...等）。

threadService 是运行它的执行方法。

现在让我们看看TThreadService.Execute;在做什么

service.ServiceCreate;

给你post一条消息给handle == TForm.Handle（<--未来容易出现两个错误）

service.ServiceStart(TThreadInfo.Create(Self) as IThreadInfo);

2.1 while info.IsRunning do

你的问题在这里是因为 info.IsRunning 检查当前线程中的终止标志（在内部否则会引发异常）这是 threadService （<-- 未来容易出错的三个）。

 2.2 **the catastrophe code**

    begin
      thread := TThreadPost.Create(handle, info);
      try
         thread.Start;
         thread.WaitFor;
         ShowMessage('Never Execute');
      finally
         thread.Free;
      end;
   end;

在这里你创建 TThreadPost 这是另一个线程并启动它。然后你调用 waitfor 锁定 TThreadService。所以现在你有三个线程运行：MainThread（空闲），threadService（死锁）和一个TThreadPost（松散）。

在TThreadPost执行方法中还有一个while info.IsRunning do

正在检查终止标志，但它是 TThreadPost 的而不是 threadService 的。

因此，当用户点击停止按钮时，MainThread 中的 waitfor 调用正在等待死锁线程。

作为解决方案，您可以按照 LU RD 所说的进行操作（当他 post 编辑他的内容时，我正在写我的答案）。

delphi 线程无限等待（永不终止）

delphi thread waitfor infinite (never terminate)

multithreading

delphi

delphi-10.1-berlin