Установить / изменить TThread.FreeOnTerminate, находясь в режиме TThread.OnTerminate

Я пытался установить FreeOnTerminate недвижимость в OnTerminate процедура, но кажется, что это слишком поздно, чтобы установить его, или он полностью игнорирует write процедура.

Как я могу установить / изменить FreeOnTerminate недвижимость в OnTerminate процедура? Есть ли обходные пути для этого?

Небольшой код:

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure OnTestThreadTerminate (Sender : TObject);
  public
    { Public declarations }
  end;

type
  TTestThread = class (TThread)
  public
    procedure Execute; override;
end;


var
  Form2: TForm2;
  GlobalThreadTest : TTestThread;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  GlobalThreadTest                    := TTestThread.Create (True);
  GlobalThreadTest.OnTerminate        := Self.OnTestThreadTerminate;
  GlobalThreadTest.FreeOnTerminate    := True;
  GlobalThreadTest.Resume;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  // 2nd Button to try to free the thread...
  // AFTER BUTTON1 has been clicked!
  try
    GlobalThreadTest.Free;
  except
    on e : exception do begin
      MessageBox(Self.Handle, pchar(e.Message), pchar(e.ClassName), 64);
    end;
  end;
end;

procedure TForm2.OnTestThreadTerminate(Sender: TObject);
begin
  TTestThread(Sender).FreeOnTerminate := False;                        // Avoid freeing...
  ShowMessage (BoolToStr (TTestThread(Sender).FreeOnTerminate, True)); // FreeOnTerminate Value has been changed successfully!
end;

procedure TTestThread.Execute;
begin
  // No code needed for test purposes.
end;

end.
Источник

3 ответа

Решение

Если вы посмотрите на источники ThreadProc в Classes.pas вы обнаружите, что FreeOnTerminate оценивается как локальная переменная Freethread перед вызовом события OnTerminate в DoTerminate.
После вызова DoTerminate поток освобождается в зависимости от устаревшей переменной: if FreeThread then Thread.Free;,
Вы можете запустить поток без FreeOnTerminate и использовать PostMessage с собственным сообщением, например WM_MyKillMessage (WM_APP + 1234), вызванным в OnTerminate, чтобы освободить поток после выхода из события OnTerminate.

Это может выглядеть так:

const
  WM_KillThread = WM_APP + 1234;
type

  TTestThread = class (TThread)
  public
    procedure Execute; override;
    Destructor Destroy;override;
end;
  TForm2 = class(TForm)
    ............... 
  public
    { Public-Deklarationen }
    procedure WMKILLTHREAD(var Msg:TMessage);message WM_KillThread;
  end;


procedure TForm2.OnTestThread(Sender: TObject);
begin
  ShowMessage ('OnTestThread');
  PostMessage(handle,WM_KillThread, WPARAM(Sender), 0);
end;

procedure TForm2.WMKILLTHREAD(var Msg: TMessage);
begin
   TTestThread(Msg.WParam).Free;
end;

destructor TTestThread.Destroy;
begin
  ShowMessage ('Destroy');
  inherited;
end;
Источник

FreeOnTerminate оценивается после Execute() выходы но раньше DoTerminate() вызывается, чтобы вызвать OnTerminate событие. Ты можешь измениться FreeOnTerminate до тех пор Execute() выходит, тогда уже поздно. Таким образом, обходной путь должен был бы вызвать OnTerminate вручную изнутри Execute()Например:

type
  TTestThread = class (TThread)
  public
    procedure Execute; override;
    procedure DoTerminate; override;
  end;


procedure TTestThread.Execute;
begin
  try
    ...
  finally
    // trigger OnTerminate here...
    inherited DoTerminate;
  end;
end;

procedure TTestThread.DoTerminate;
begin
  // prevent TThread from triggering OnTerminate
  // again by not calling inherited here...
end;

Единственная ошибка в том, что если Terminate() называется раньше Execute() называется тогда TThread пропущу Execute(), но он все равно будет называться переопределенным DoTerminate(),

Источник

Предположительно, вы хотите установить FreeOnTerminate Ложь в каком-то состоянии, но в остальном пусть она останется Истиной. Если это условие каким-либо образом зависит от того, является ли его завершение естественным (выполнение завершилось нормально без вмешательства) или ручным (вызывается завершение), то я предлагаю вам сделать прямо противоположное: создать поток с FreeOnTerminate = False и установите его True, когда Terminated свойство False:

procedure TTestThread.Execute;
begin
  ...
  if not Terminated then
    FreeOnTerminate := True;
end;

См. Его функционирование, например, в разделе Когда вручную освобождать тему.

Источник
Другие вопросы по тегам