Delphi - потоки, остановленные пользователем или автоматически завершающиеся по истечении определенного периода времени

Question

Основываясь на нескольких вопросах здесь, в SO, я реализовал поток, который может быть убит пользователем до завершения его работы или если я его установлю для самостоятельного завершения через определенный промежуток времени.

реализация Тема:

unit Unit2; 

interface 

uses SyncObjs 
    ,classes 
    ,System.SysUtils 
    ,windows; 

type 
    TMyThread = class(TThread) 
    private 
    FTerminateEvent: TEvent; 
    FTimerStart: Cardinal; 
    FTimerLimit: Cardinal; 
    FTimeout: Boolean; 
    protected 
    procedure Execute; override; 
    procedure TerminatedSet; override; 
    public 
    constructor Create(ACreateSuspended: Boolean; Timeout: Cardinal); overload; 
    destructor Destroy; override; 
    end; 

implementation 

constructor TMyThread.Create(ACreateSuspended: Boolean; TimeOut: Cardinal); 
begin 
    inherited Create(ACreateSuspended); 
    FTerminateEvent := TEvent.Create(nil, True, False, ''); 
    FTimerStart:=GetTickCount; 
    FTimerLimit:=Timeout; 
    FTimeout:=True; 
end; 

destructor TMyThread.Destroy; 
begin 
    OutputDebugString(PChar('destroy '+inttostr(Handle))); 
    inherited; 
    FTerminateEvent.Free; 
end; 

procedure TMyThread.TerminatedSet; 
begin 
    FTerminateEvent.SetEvent; 
end; 

procedure TMyThread.Execute; 
var 
    FTimerNow:Cardinal; 
begin 
    FTimerNow:=GetTickCount; 

    while not(Terminated) and ((FTimerNow-FTimerStart)<FTimerLimit) do 
    begin 
    OutputDebugString(PChar('execute '+inttostr(Handle))); 

    FTerminateEvent.WaitFor(100); 

    FTimerNow:=GetTickCount; 
    end; 
    if (FTimerNow-FTimerStart) > FTimerLimit then 
    begin 
    self.Free; 
    end; 
end; 

end. 

и как потоки создаются в главном блоке приложения

unit Unit1; 

interface 

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

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    private 
    t1,t2: TMyThread; 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
// 
    if t1 = nil then 
    t1 := TMyThread.Create(false,10000) 
    else 
if t2 = nil then 
    t2 := TMyThread.Create(False,10000); 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
// 
    if t1 <> nil then 
    begin 
    t1.Free; 
    t1 := nil; 
    end 
    else 
    if t2 <> nil then 
    begin 
    t2.Free; 
    t2 := nil; 
    end; 
end; 

end. 

То, что я хочу, это рабочий поток, который останавливается либо когда я убиваю его , либо через определенный промежуток времени. Проблема возникает, когда поток нуждается в самостоятельном завершении, потому что там я получаю утечки памяти, и мое событие не освобождается.

LE: настройка FreeOnTerminate на True приводит к нарушениям множественного доступа.

Answer 1

Основная проблема заключается в том, что ссылки на ваши потоки хранятся в t1 и t2.

Поэтому вы должны позаботиться об этих ссылках. Лучший вариант - использовать событие TThread.OnTerminate, чтобы получать информацию, когда поток подходит к концу. В сочетании с TThread.FreeOnTerminate, установленным на true, следует решить ваши проблемы.

procedure TForm1.Button1Click(Sender: TObject); 
begin 
// 
    if t1 = nil then 
    begin 
    t1 := TMyThread.Create(false,10000); 
    t1.OnTerminate := ThreadTerminate; 
    t1.FreeOnTerminate := True; 
    end 
    else if t2 = nil then 
    begin 
    t2 := TMyThread.Create(False,10000); 
    t2.OnTermiante := ThreadTerminate; 
    t2.FreeOnTerminate := True; 
    end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
// 
    if t1 <> nil then 
    t1.Terminate 
    else if t2 <> nil then 
    t2.Terminate; 
end; 

procedure TForm1.ThreadTerminate(Sender : TObject); 
begin 
    if Sender = t1 then 
    t1 := nil 
    else if Sender = t2 then 
    t2 := nil; 
end; 

UPDATE

Вы никогда не должны освободить сам экземпляр с Self.Free. Это приведет вас к обвисшим ссылкам по дизайну.

Answer 2

Рассмотрите установку TThread.FreeOnTerminate собственности на true. Это уничтожит объект Thread после завершения выполнения.

Имейте в виду, что после завершения выполнения потока вы не можете получить доступ к какой-либо публичной собственности. Этот подход работает только в том случае, если вам не нужно читать что-то из потока после завершения.

Answer 3

Установка FreeOnTerminate в true, означает, что вы должны never попытайтесь получить доступ к экземпляру TMyThread. Вы никогда не сможете предсказать, действителен ли экземпляр после попытки доступа к нему.

Также вы можете позвонить по телефону Self.Free по телефону Execute. Просто позвольте методу Execute завершить свою работу, а остальное позаботится.

Безопасный способ завершения потока через определенное время или событие - передать внешнему обработчику событий в ваш поток и установить значение FreeOnTerminate в значение true.