德爾福 - 線程停止由用戶或自我終止後一段時間

基於這裏幾個問題，所以我已經實現了一個線程，可以在完成它的工作之前被用戶殺死，或者如果我設置它在一段時間後自行終止。德爾福 - 線程停止由用戶或自我終止後一段時間

線程執行：

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會導致多次訪問衝突。

來源

2015-04-27 RBA

這裏的主要問題是存儲在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。這會導致你通過設計懸掛引用。

來源

2015-04-27 12:20:56

在FreeOnTerminate線程實例上調用Terminate是個壞主意。它可以通過超時釋放。還不需要管理零設置。只需從局部變量或沒有任何變量創建線程。 –

使用標誌來告訴線程何時在「OnTerminate」事件中完成其作業。 –

@LURD事件['TThread.OnTerminate']（http://docwiki.embarcadero.com/Libraries/en/System.Classes.TThread.OnTerminate）是MainThread上下文中的同步調用。如果你輸入方法'TForm1。Button2Click'，你將在't1' /'t2'或'nil'引用中有一個有效的引用。所以這種方法是安全的 –

考慮將TThread.FreeOnTerminate屬性設置爲true。一旦執行完成，這將破壞線程對象。

請記住，線程執行結束後無法訪問任何公共屬性。這種方法只有在你不需要從線程讀取一次終止的東西時才起作用。

來源

2015-04-27 12:01:50 Ghigo

我試過了，由於線程的解剖結構，導致多次訪問違規。 – RBA

將FreeOnTerminate設置爲true，表示您應該從不嘗試訪問TMyThread的實例。一旦您嘗試訪問實例，您無法預測該實例是否有效。

在Execute方法中調用Self.Free也是錯誤的。只要讓Execute方法完成其工作，其餘的事情都會得到照顧。

在特定時間或事件發生後讓線程終止的安全方法是將外部事件處理程序傳遞到您的線程並將FreeOnTerminate設置爲true。

來源

2015-04-27 12:17:06

德爾福 - 線程停止由用戶或自我終止後一段時間

回答

相關問題