基于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
会导致多次访问违规。
答案 0 :(得分:4)
将FreeOnTerminate
设置为true表示您应从不尝试访问TMyThread
的实例。一旦您尝试访问该实例,就无法预测该实例是否有效。
在Self.Free
方法中调用Execute
也是错误的。只需让Execute
方法完成其工作,剩下的工作就完成了。
让线程在一定时间或事件之后终止的安全方法是将外部事件处理程序传递给您的线程并将FreeOnTerminate
设置为true。
答案 1 :(得分:3)
这里的主要问题是存储在t1
和t2
中的线程的悬空引用。
所以你必须照顾这个参考。最好的选择是使用TThread.OnTerminate
事件在线程结束时获得通知。结合设置为TThread.FreeOnTerminate
的{{1}}可以解决您的问题。
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;
释放实例本身。这将引导您通过设计悬挂参考文献。
答案 2 :(得分:1)
考虑将TThread.FreeOnTerminate
属性设置为true。执行完成后,这将破坏Thread对象。
请记住,线程执行结束后您无法访问任何公共属性。只有在终止后不需要从线程中读取内容时,此方法才有效。