德尔福 - 线程停止由用户或自我终止后一段时间

基于这里几个问题，所以我已经实现了一个线程，可以在完成它的工作之前被用户杀死，或者如果我设置它在一段时间后自行终止。德尔福 - 线程停止由用户或自我终止后一段时间

线程执行：

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

德尔福 - 线程停止由用户或自我终止后一段时间

回答

相关问题