Delphi - 用户停止线程或一段时间后自行终止

时间:2015-04-27 11:52:54

标签: multithreading delphi delphi-xe6

基于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会导致多次访问违规。

3 个答案:

答案 0 :(得分:4)

FreeOnTerminate设置为true表示您应从不尝试访问TMyThread的实例。一旦您尝试访问该实例,就无法预测该实例是否有效。

Self.Free方法中调用Execute也是错误的。只需让Execute方法完成其工作,剩下的工作就完成了。

让线程在一定时间或事件之后终止的安全方法是将外部事件处理程序传递给您的线程并将FreeOnTerminate设置为true。

答案 1 :(得分:3)

这里的主要问题是存储在t1t2中的线程的悬空引用。

所以你必须照顾这个参考。最好的选择是使用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对象。

请记住,线程执行结束后您无法访问任何公共属性。只有在终止后不需要从线程中读取内容时,此方法才有效。