Question

我等待线程完成，但没有成功，它会陷入WaitFor（）方法;并且不会回来，无限期地站在那里。

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

在我们开始之前，请在下次使用＆＃39; F＆＃39;来开始您班级中的字段名称。

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

procedure TForm1.btnStartClick(Sender: TObject);

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

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

threadService := TThreadService.Create(service);

您创建了TThread的已暂停实例，并将service分配给其私有字段service（您应该再将其命名为FService并且您不需要使用自己）

有一点是这次引用的引用不同于引用在范围结束时丢失/丢失的第一行。

threadService.OnTerminate := OnThreadTerminate;

指定Onterminate事件处理程序。

Onterminate在内部使用synchronize（），这可能是导致死锁的原因。（＆lt; ---未来容易出错的人）

threadService.Start;

您启动暂停的threadService。

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

MainThread处于空闲状态，等待更多用户操作或处理其他消息（即：重新粉刷，调整大小，移动形式....等等。）

threadService正在运行其execute方法。

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

service.ServiceCreate;

在这里，您向handle == TForm.Handle发布消息（＆lt; - 未来容易出错的两个）

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

2.1 while info.IsRunning do

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

 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所说的解决方案（当我发布他的时候我正在写我的答案）。

delphi线程waitfor无限（永不终止）

2 个答案: