线程销毁永远不会被执行

Question

下载带有已编译可执行文件的源代码（221 KB（226,925 字节））：http://www .eyeclaxton.com/download/delphi/sculpture.zip

如果我在线程终止之前关闭应用程序（单击 X 按钮），为什么 Destroy 析构函数不会被调用？ FastMM4 通过 FPauseEvent 事件报告内存泄漏。

我应该如何销毁线程？如果有人在线程完成之前关闭应用程序。

unit SkeletonThread;

interface

uses
  Windows, Classes, SysUtils, SyncObjs;

type
  TOnInitialize = procedure(Sender: TObject; const AMaxValue: Integer) of object;
  TOnBegin = procedure(Sender: TObject) of object;
  TOnProgress = procedure(Sender: TObject; const APosition: Integer) of object;
  TOnPause = procedure(Sender: TObject; const APaused: Boolean) of object;
  TOnFinish = procedure(Sender: TObject) of object;
  TOnFinalize = procedure(Sender: TObject) of object;

  TMasterThread = class(TThread)
  private
    { Private declarations }
    FPaused: Boolean;
    FPosition: Integer;
    FMaxValue: Integer;
    FOnBegin: TOnBegin;
    FOnProgress: TOnProgress;
    FOnFinish: TOnFinish;
    FOnInitialize: TOnInitialize;
    FOnFinalize: TOnFinalize;
    FPauseEvent: TEvent;
    FOnPause: TOnPause;
    procedure BeginEvent();
    procedure ProgressEvent();
    procedure FinishEvent();
    procedure InitializeEvent();
    procedure FinalizeEvent();
    procedure PauseEvent();
    procedure CheckForPause();
  protected
    { Protected declarations }
    procedure DoInitializeEvent(const AMaxValue: Integer); virtual;
    procedure DoBeginEvent(); virtual;
    procedure DoProgress(const APosition: Integer); virtual;
    procedure DoPauseEvent(const APaused: Boolean); virtual;
    procedure DoFinishEvent(); virtual;
    procedure DoFinalizeEvent(); virtual;
  public
    { Public declarations }
    constructor Create(const CreateSuspended: Boolean; const theValue: Integer);
    destructor Destroy(); override;
    procedure Pause();
    procedure Unpause();
  published
    { Published declarations }
    property IsPaused: Boolean read FPaused write FPaused default False;
    property OnInitialize: TOnInitialize read FOnInitialize write FOnInitialize default nil;
    property OnBegin: TOnBegin read FOnBegin write FOnBegin default nil;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress default nil;
    property OnPause: TOnPause read FOnPause write FOnPause default nil;
    property OnFinish: TOnFinish read FOnFinish write FOnFinish default nil;
    property OnFinalize: TOnFinalize read FOnFinalize write FOnFinalize default nil;
  end;

  TSkeletonThread = class(TMasterThread)
  private
    { Private declarations }
    procedure DoExecute(const theValue: Integer);
  protected
    { Protected declarations }
    procedure Execute(); override;
  public
    { Public declarations }
  published
    { Published declarations }
  end;

implementation

{ TMasterThread }
constructor TMasterThread.Create(const CreateSuspended: Boolean; const theValue: Integer);
begin
  inherited Create(CreateSuspended);
  Self.FreeOnTerminate := True;

  Self.FPosition := 0;
  Self.FMaxValue := theValue;
  Self.FPaused := False;
  Self.FPauseEvent := TEvent.Create(nil, True, True, '');
end;

destructor TMasterThread.Destroy();
begin
  FreeAndNil(FPauseEvent);
  if (Pointer(FPauseEvent) <> nil) then Pointer(FPauseEvent) := nil;
  inherited Destroy();
end;

procedure TMasterThread.DoBeginEvent();
begin
  if Assigned(Self.FOnBegin) then Self.FOnBegin(Self);
end;

procedure TMasterThread.BeginEvent();
begin
  Self.DoBeginEvent();
end;

procedure TMasterThread.DoProgress(const APosition: Integer);
begin
  if Assigned(Self.FOnProgress) then Self.FOnProgress(Self, APosition);
end;

procedure TMasterThread.ProgressEvent();
begin
  Self.DoProgress(Self.FPosition);
end;

procedure TMasterThread.DoFinishEvent();
begin
  if Assigned(Self.FOnFinish) then Self.FOnFinish(Self);
end;

procedure TMasterThread.FinishEvent();
begin
  Self.DoFinishEvent();
end;

procedure TMasterThread.DoInitializeEvent(const AMaxValue: Integer);
begin
  if Assigned(Self.FOnInitialize) then Self.FOnInitialize(Self, AMaxValue);
end;

procedure TMasterThread.InitializeEvent();
begin
  Self.DoInitializeEvent(Self.FMaxValue);
end;

procedure TMasterThread.DoFinalizeEvent();
begin
  if Assigned(Self.FOnFinalize) then Self.FOnFinalize(Self);
end;

procedure TMasterThread.FinalizeEvent;
begin
  Self.DoFinalizeEvent();
end;

procedure TMasterThread.DoPauseEvent(const APaused: Boolean);
begin
  if Assigned(Self.FOnPause) then Self.FOnPause(Self, APaused);
end;

procedure TMasterThread.PauseEvent();
begin
  Self.DoPauseEvent(Self.FPaused);
end;

procedure TMasterThread.Pause();
begin
  Self.FPauseEvent.ResetEvent();
  Self.FPaused := True;
  Self.Synchronize(Self.PauseEvent);
end;

procedure TMasterThread.Unpause();
begin
  Self.FPaused := False;
  Self.Synchronize(Self.PauseEvent);
  Self.FPauseEvent.SetEvent();
end;

procedure TMasterThread.CheckForPause();
begin
  if (not (Self.Terminated)) then Windows.Sleep(1);
  Self.FPauseEvent.WaitFor(INFINITE);
end;

{ TSkeletonThread }
procedure TSkeletonThread.DoExecute(const theValue: Integer);
var
  X: Integer;
begin
  Self.Synchronize(InitializeEvent);
  try
    Self.Synchronize(BeginEvent);
    try
      for X := 0 to (theValue - 1) do
      begin
    Self.CheckForPause();

    if (not Self.FPaused) and (not Self.Terminated) then
    begin
      Self.FPosition := Self.FPosition + 1;
      Self.Synchronize(ProgressEvent);
    end
    else begin
      Break;
    end;
      end;

      for X := Self.FPosition downto 1 do
      begin
    Self.CheckForPause();

    if (not Self.FPaused) and (not Self.Terminated) then
    begin
      Self.FPosition := X;
      Self.Synchronize(ProgressEvent);
    end
    else begin
      Break;
    end;
      end;
    finally
      Self.Synchronize(FinishEvent);
    end;
  finally
    Self.Synchronize(FinalizeEvent);
  end;
end;

procedure TSkeletonThread.Execute();
begin
  Self.DoExecute(Self.FMaxValue);
end;

end.

Answer 1

您必须自己终止线程（告诉它停止）。一种方法是使用线程的 Terminate 过程，但您必须在线程的 Execute 方法中检查这一点。像这样的事情：

procedure Execute;
begin
  inherited;

  while not Terminated do
  begin
    // do your job
  end;
end;

procedure TForm1.StopThread;
begin
  MyThread.Terminate;

  // wait and block until the scheduling thread is finished
  AResult := WaitForSingleObject(MyThread.Handle, cShutdownTimeout);

  // check if we timed out
  if AResult = WAIT_TIMEOUT then
    TerminateThread(MyThread.Handle, 0);
end;

或者您可以使用窗口内置的信号化，这样您就不必循环。

procedure Execute;
begin
  inherited;

  while not Terminated do
  begin
    WaitStatus := WaitForSingleObject(FTermEvent, Max(0, SleepInterval));

    // check what was the cause for signalization
    if WaitStatus <> WAIT_TIMEOUT then
      Terminate;
  end;
end;

procedure TForm1.StopThread;
begin
  // Terminate the thread
  SetEvent(FTermEvent);
  // close the handle
  CloseHandle(FTermEvent);

  // wait and block until the scheduling thread is finished
  AResult := WaitForSingleObject(MyThread.Handle, cShutdownTimeout);

  // check if we timed out
  if AResult = WAIT_TIMEOUT then
    TerminateThread(MyThread.Handle, 0);
end;

信号化是发出终止信号的非常简洁的方式，因为您可以使用 WaitForMultipleObjects 并在不同条件下释放等待。我使用 WaitForSingleObject 来避免让事情变得太复杂。

还要确保在线程构造函数中设置“FreeOnTerminate := True”。哦，最后的硬终止当然是可选的。这可能很危险。你自己最清楚是否会使用它。如果您确定线程最终会停止，您也可以等待更长的时间或无限期。