Delphi - 线程被用户停止或在一段时间后自行终止
Delphi - thread stopped by user or self-terminate after a period of time
基于这里关于 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
会导致多次访问冲突。
考虑将 TThread.FreeOnTerminate
属性 设置为真。这将在执行完成后销毁 Thread 对象。
请记住,线程执行结束后您将无法访问任何 public 属性。这种方法只有在你不需要从线程终止后读取内容时才有效。
将 FreeOnTerminate
设置为 true,意味着您应该 永远不会 尝试访问 TMyThread
的实例。一旦您尝试访问该实例,您将永远无法预测该实例是否有效。
在Execute
方法中调用Self.Free
也是错误。只需让 Execute
方法完成它的工作,剩下的就交给你了。
让线程在特定时间后或因事件终止的安全方法是将外部事件处理程序传递给您的线程并将 FreeOnTerminate
设置为 true。
这里的主要问题是对存储在 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;
更新
您永远不应该使用 Self.Free
释放实例本身。这将导致您设计成悬挂引用。
基于这里关于 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
会导致多次访问冲突。
考虑将 TThread.FreeOnTerminate
属性 设置为真。这将在执行完成后销毁 Thread 对象。
请记住,线程执行结束后您将无法访问任何 public 属性。这种方法只有在你不需要从线程终止后读取内容时才有效。
将 FreeOnTerminate
设置为 true,意味着您应该 永远不会 尝试访问 TMyThread
的实例。一旦您尝试访问该实例,您将永远无法预测该实例是否有效。
在Execute
方法中调用Self.Free
也是错误。只需让 Execute
方法完成它的工作,剩下的就交给你了。
让线程在特定时间后或因事件终止的安全方法是将外部事件处理程序传递给您的线程并将 FreeOnTerminate
设置为 true。
这里的主要问题是对存储在 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;
更新
您永远不应该使用 Self.Free
释放实例本身。这将导致您设计成悬挂引用。