在我的应用程序中，我使用基于线程的任务。他们工作正常，但有时他们挂起应用程序。在下面的代码procedure Stop中，有时会挂起WaitFor过程。这是因为FStopEvent.SetEvent似乎并不总是起作用。
在正常执行期间，线程进入Execute过程，执行OnWork过程，直到调用Stop（设置Terminated），然后执行一些后处理，然后执行退出。这是WaitFor退出的信号，每个人都很开心。在我的使用中，这是因为任务被销毁。在这种情况下，调用基类的析构函数，调用Stop。
在某些情况下，这不起作用。正确输入Execute，OnWork过程调用执行正常，但FStopEvent.SetEvent没有反应。没有崩溃（except的声明没有执行）只是没有。程序挂起，因为WaitFor没有返回。使用调试DCU，我可以将其追溯到WaitFor单元Classes，其中程序挂起WaitForSingleObject(H[0], INFINITE);。 OnWork回调是一样的。
OnBeforeWork和OnAfterWork程序为零。 MaxLoops = -1和FreeOnTerminate = False。我非常绝望，希望有人有出路。
编辑1：我正在谈论的WaitFor发生在下面列出的课程TEvent_Driven_Task中。因为这个类是从类TSimple_Task派生的，所以为了完整性我添加了这个类。
编辑2： Application.ProcessMessages已从TSimple_Task.Stop移除，因为Marjan Venema表示这可能会导致问题。结果是相同的（程序挂起在WaitFor）。
unit Parallel_Event_Task;
interface
uses Forms, Windows, Classes, SysUtils, SyncObjs,
Parallel_Simple_Task;
type
TEvent_Driven_Task = class (TSimple_Task)
private
FWorkEvent: TEvent; // Event signalling that some work should be done
public
constructor Create (work: TNotifyEvent; CreateSuspended: boolean = False;
max: Int32 = 1;
before: TNotifyEvent = nil; after: TNotifyEvent = nil;
terminate: boolean = True; task: integer = 1); override;
destructor Destroy; override;
procedure Activate (work: TNotifyEvent = nil);
procedure Execute; override;
procedure Stop; override;
procedure Release; override;
end; // Class: TEvent_Driven_Task //
implementation
constructor TEvent_Driven_Task.Create
(
work: TNotifyEvent; // Work to do in Execute loop
CreateSuspended: boolean = False; // False = start now, True = use Start
max: Int32 = 1; // Max loops of Execute loop, negative = infinite loop
before: TNotifyEvent = nil;// Called before Execute loop
after: TNotifyEvent = nil; // Called after Execute loop
terminate: boolean = True; // When true free the task on termination
task: integer = 1 // Task ID
);
begin
inherited Create (work, CreateSuspended, max, before, after, terminate, task);
FWorkEvent := TEvent.Create (nil, False, False, '');
end; // Create //
Destructor TEvent_Driven_Task.Destroy;
begin
inherited Destroy;
end; // Destroy //
procedure TEvent_Driven_Task.Activate (work: TNotifyEvent = nil);
begin
if Assigned (work) then OnWork := work;
FWorkEvent.SetEvent;
end; // Activate //
// Execute calls event handler OnWork in a while loop.
// Before the loop is entered, OnBeforeWork is executed, after: OnAfterWork.
procedure TEvent_Driven_Task.Execute;
var two: TWOHandleArray;
pwo: PWOHandleArray;
ret: DWORD;
begin
pwo := @two;
pwo [0] := FWorkEvent.Handle;
pwo [1] := FStopEvent.Handle;
NameThreadForDebugging (AnsiString (FTaskName));
FLoop := 0;
try
if Assigned (OnBeforeWork) then OnBeforeWork (Self);
while (not Terminated) and (Loop <> Max_Loops) do
begin
FLoop := FLoop + 1;
ret := WaitForMultipleObjects (2, pwo, FALSE, INFINITE);
if ret = WAIT_FAILED then Break;
case ret of
WAIT_OBJECT_0 + 0: if Assigned (OnWork) then OnWork (Self);
WAIT_OBJECT_0 + 1: Terminate;
end; // case
end; // while
if Assigned (OnAfterWork) then OnAfterWork (Self);
// Intercept and ignore the interruption but keep the message
except
on e: exception do FError_Mess := e.Message;
end; // try..except
end; // Execute //
procedure TEvent_Driven_Task.Stop;
begin
Terminate;
FStopEvent.SetEvent;
if not FreeOnTerminate
then WaitFor;
end; // Stop //
procedure TEvent_Driven_Task.Release;
begin
inherited Release;
FWorkEvent.Free;
end; // Release //
end. // Unit: Parallel_Simple_Task //
=============基类=======================
unit Parallel_Simple_Task;
interface
uses Windows, Classes, SysUtils, SyncObjs, Forms;
type
TSimple_Task = class (TThread)
protected
FStopEvent: TEvent; // Event signalling that the thread has to terminate, set by Stop
FTaskID: integer; // Task sequence number
FTaskName: string; // Task name
FLoop: integer; // Indicates number of times Work has been processed
FMax_Loops: integer; // Maximum # of iterations
FError_Mess: string; // Error message if an exception occurred, else empty
FOnBeforeWork: TNotifyEvent; // Event to be called just before thread loop is entered
FOnWork: TNotifyEvent; // Event caled in Execute loop
FOnAfterWork: TNotifyEvent; // Event to be called just after thread loop is finished
procedure set_name (value: string);
public
constructor Create (work: TNotifyEvent; CreateSuspended: boolean = False; max: Int32 = 1;
before: TNotifyEvent = nil; after: TNotifyEvent = nil;
terminate: boolean = True; task: integer = 1); reintroduce; virtual;
destructor Destroy; override;
procedure Execute; override;
procedure Stop; virtual;
procedure Release; virtual;
property TaskID: integer read FTaskID;
property TaskName: string read FTaskName write set_name;
property Loop: integer read FLoop;
property Max_Loops: integer read FMax_Loops write FMax_Loops;
property OnBeforeWork: TNotifyEvent read FOnBeforeWork write FOnBeforeWork;
property OnWork: TNotifyEvent read FOnWork write FOnWork;
property OnAfterWork: TNotifyEvent read FOnAfterWork write FOnAfterWork;
end; // Class: TSimple_Task //
implementation
constructor TSimple_Task.Create
(
work: TNotifyEvent; // Work to do in Execute loop
CreateSuspended: boolean = False; // False = start now, True = use Start
max: Int32 = 1; // Max loops of Execute loop
before: TNotifyEvent = nil;// Called before Execute loop
after: TNotifyEvent = nil; // Called after Execute loop
terminate: boolean = True; // When true free the task on termination
task: integer = 1 // Task ID
);
begin
// The thread will only be started when this constructor ends.
inherited Create (CreateSuspended);
FStopEvent := TEvent.Create (nil, True, False, '');
FError_Mess := '';
FTaskID := task;
FTaskName := '';
Max_Loops := max;
OnBeforeWork := before;
OnWork := work;
OnAfterWork := after;
FreeOnTerminate := terminate;
end; // Create //
destructor TSimple_Task.Destroy;
begin
Stop;
Release;
inherited Destroy;
end; // Destroy //
// Execute calls event handler OnWork in a while loop.
// Before the loop is entered, OnBeforeWork is executed, after: OnAfterWork.
procedure TSimple_Task.Execute;
var ret: DWORD;
begin
try
NameThreadForDebugging (AnsiString (FTaskName));
FLoop := 0;
if Assigned (OnBeforeWork) then OnBeforeWork (Self);
while (not Terminated) and (FLoop <> Max_Loops) do
begin
ret := WaitForSingleObject (FStopEvent.Handle, 0);
if ret = WAIT_OBJECT_0 then
begin
Terminate;
end else
begin
if Assigned (OnWork) then OnWork (Self);
FLoop := FLoop + 1;
end; // if
end; // while
if not Terminated and Assigned (OnAfterWork) then OnAfterWork (Self);
// Intercept and ignore the interruption but keep the message
except
on e: exception do FError_Mess := e.Message;
end; // try..except
end; // Execute //
procedure TSimple_Task.Stop;
begin
Terminate;
FStopEvent.SetEvent;
if not FreeOnTerminate
then WaitFor;
end; // Stop //
procedure TSimple_Task.Release;
begin
FStopEvent.Free;
end; // Release //
procedure TSimple_Task.set_name (value: string);
begin
FTaskName := value;
end; // set_name //
end. // Unit: Parallel_Simple_Task //
答案 0 :(得分：7)
TThread.WaitFor()等待线程句柄（TThread.Handle属性）在底层线程对象终止于OS层时发出信号。在TThread方法退出后（以及ExitThread()被调用并退出后）Execute()调用Win32 API TThread.DoTerminate()函数时，会发出该信号。您所描述的内容听起来就像您遇到了阻止Execute()方法正确退出的死锁，即使您可能已发出FStopEvent信号来停止循环。根据您显示的代码，这意味着WaitForMultipleObjects()正在返回您不想要的错误代码，或者更有可能OnWork事件处理程序没有正确退出，因此Execute()可以然后退出。
到目前为止，您所显示的是您的任务类本身的定义，但您尚未展示它们在您的项目中的实际使用方式。请显示其余的任务逻辑，并停止让人们猜出问题可能是什么。
我建议的第一件事是从您的析构函数中接听Stop()。它不属于那里。 从不销毁仍在运行的线程。始终先停止线程并等待它完成终止，然后再将其销毁。 TThread本身有足够的问题，在运行时它自己被销毁，你不需要添加它。