Delphi - 如何在没有内存丢失的情况下确保正确可靠地终止线程

时间:2017-03-10 03:29:24

标签: delphi delphi-10.1-berlin

情况:我有一个程序可以启动一个在后台连续运行的线程。当我终止此线程时,我间歇性地得到运行时错误204(无效指针)和内存泄漏。

创建线程的代码(它是在对象TJEList中创建的,该对象具有OnLJ2DOSyncThreadNotification方法,该方法在通知中调用,使用线程中的某些TStringList对象执行某些操作):

  FLJ2DOSyncThread:=TLJ2DOSyncThread.Create (True);
  FLJ2DOSyncThread.NotifyEvent:=OnLJ2DOSyncThreadNotification;
  FLJ2DOSyncThread.Start;

线程的Execute代码:

  FreeOnTerminate:=True;

  //I create 5 StringList objects here - they are declared as private variables in the Thread

  try
    while Not Terminated do
    begin
      //Perform operation (which internally also checks for Terminated)
      if Terminated then
        Break;
      //Perform different operation (which internally also checks for Terminated)
      if Terminated then
        Break;
      //Perform different operation (which internally also checks for Terminated)
      if Terminated then
        Break;
      //etc...
      Sleep (1500);
    end;
  finally
    //I FreeAndNil(...) all the TStringlist objects
  end;

为了获得良好的衡量标准(虽然可能是多余的),我在线程中也有一个析构函数:

 if Assigned (TStringList object) then FreeAndNil (TStringList object);

为所有创建的TStringList对象(然后调用inherited;)。

我停止该帖子的代码是:

  if Assigned(FLJ2DOSyncThread) then
    if FLJ2DOSyncThread.Started then
      FLJ2DOSyncThread.Terminate;

我调用代码来停止来自TJEList对象的析构函数的线程(在应用程序的主窗体的闭包上调用它)。

问题: 有时,程序干净地终止(没有内存泄漏或错误消息)。其他时候,我收到以下错误消息和内存泄漏(为了它的价值,在运行时错误消息之前出现内存泄漏消息):

enter image description here

enter image description here

我的问题:如何确保线程始终可靠地终止(因此被释放)?任何帮助和/或指导都将非常感谢!

更新20170310 5.08pm HKT:根据要求包括MCVE代码

计划代码:

program ThreadIssueMCVE;

uses
  System.StartUpCopy,
  FMX.Forms,
  frmMain in 'frmMain.pas' {fMain},
  MyList in 'MyList.pas',
  MyThread in 'MyThread.pas';

{$R *.res}

begin
  {$IFDEF DEBUG}
  System.ReportMemoryLeaksOnShutdown:=true;
  {$ENDIF}
  Application.Initialize;
  Application.CreateForm(TfMain, fMain);
  Application.Run;
end.

主要表格代码:

unit frmMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, MyList,
  FMX.Controls.Presentation, FMX.StdCtrls;

type
  TfMain = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FMyList: TMyList;
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

implementation

{$R *.fmx}

procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(FMyList);
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
  FMyList:=TMyList.Create;
end;

end.

MyList代码:

unit MyList;

interface

uses
  System.Classes, System.SysUtils, MyThread;


type
  TMyList = Class (TObject)
  private
    FSomeList: TStringList;
    FMyThread: TMyThread;
  protected
    procedure OnMyThreadNotification (Sender: TObject);
    procedure OnMyThreadTerminate (Sender: TObject);
    procedure ActOnThreadResults (AList: TStringList);
  public
    procedure InitMyThread;
    procedure StopMyThread;
    constructor Create;
    destructor Destroy; override;
  property
    SomeList: TStringList read FSomeList;
  end;

implementation

{ TMyList }

constructor TMyList.Create;
begin
  inherited Create;

  FSomeList:=TStringList.Create;

  InitMyThread;
end;

destructor TMyList.Destroy;
begin
  StopMyThread;

  FreeAndNil(FSomeList);

  inherited Destroy;
end;

procedure TMyList.ActOnThreadResults (AList: TStringList);
var
  i: Integer;
begin
  for i:= 0 to AList.Count-1 do
  begin
    if FMyThread.CheckTerminated then
      exit;
    FSomeList.Add(AList.Strings[i]);
  end;
end;

procedure TMyList.InitMyThread;
begin
  FMyThread:=TMyThread.Create (True);
  FMyThread.NotifyEvent:=OnMyThreadNotification;
  FMyThread.OnTerminate:=OnMyThreadTerminate;
  FMyThread.Start;
end;

procedure TMyList.OnMyThreadNotification(Sender: TObject);
var
  fullList: TStringList;
begin
  if (FMyThread.FList4.Count>0) or (FMyThread.FList5.Count>0) then
  begin
    fullList:=TStringList.Create;
    try
      fullList.Text:=FMyThread.FList4.Text + FMyThread.FList5.Text;
      ActOnThreadResults(fullList);
    finally
      FreeAndNil (fullList);
    end;
  end;
end;

procedure TMyList.OnMyThreadTerminate(Sender: TObject);
begin
  FreeAndNil(FMyThread);
end;

procedure TMyList.StopMyThread;
begin
  FMyThread.Terminate;
end;

end.

MyThread代码:

unit MyThread;

interface

uses
  System.Classes, System.SysUtils;

type
  TMyThread = Class (TThread)
  private
    FLastRun: TDateTime;
    FList1: TStringList;
    FList2: TStringList;
    procedure SomeProcess;
    procedure SomeOtherProcess;
  protected
    procedure Execute; override;
  public
    NotifyEvent: TNotifyEvent;
    FList3: TStringList;
    FList4: TStringList;
    FList5: TStringList;
    destructor Destroy; override;
  End;

implementation

destructor TMyThread.Destroy;
begin
  FreeAndNil(FList1);
  FreeAndNil(FList2);
  FreeAndNil(FList3);
  FreeAndNil(FList4);
  FreeAndNil(FList5);

  inherited;
end;

procedure TMyThread.SomeOtherProcess;
var i: integer;
begin
  for i := 1 to 1000000 do
  begin
    if Terminated then
      break;

    //do some stuff here
    FList5.Add(i.ToString);
  end;
end;

procedure TMyThread.SomeProcess;
var i: integer;
begin
  for i := 1 to 1000000 do
  begin
    if Terminated then
      break;

    //do some stuff here
    FList4.Add(i.ToString);
  end;
end;


procedure TMyThread.Execute;
var
  boolCheck: Boolean;
begin
  NameThreadForDebugging('Thread with issues');
  FreeOnTerminate:=False;

  FList1:=TStringList.Create;
  FList2:=TStringList.Create;
  FList3:=TStringList.Create;
  FList4:=TStringList.Create;
  FList5:=TStringList.Create;
  FLastRun:=Now; //i get this from an ini file normally

  try
    while Not Terminated do
    begin
      if Terminated then
        Break;
      FList1.Clear;
      FList2.Clear;
      FList3.Clear;
      FList4.Clear;
      FList5.Clear;

      if Terminated then
        Break;
      SomeProcess;
      if Terminated then
        Break;
      SomeOtherProcess;
      if Terminated then
        Break;
      SomeProcess;
      if Terminated then
        Break;
      SomeOtherProcess;
      if Terminated then
        Break;
      SomeProcess;
      if Terminated then
        Break;

      if (FList4.Count>0) OR (FList5.Count>0) then
        boolCheck:=True;

      if Terminated then
        Break;
      if boolCheck then
        NotifyEvent(Self);

      if Terminated then
        Break;
      Sleep (2000);

      if Terminated then
        Break;

      FLastRun:=Now;      //i save to ini file as well
    end;
  finally
    //i save to ini file the last run
    FreeAndNil(FList1);
    FreeAndNil(FList2);
    FreeAndNil(FList3);
    FreeAndNil(FList4);
    FreeAndNil(FList5);
  end;
end;

end.

1 个答案:

答案 0 :(得分:0)

你有种族危险。如果在线程自然终止之前销毁TMyList对象,它仍然可以调用notify事件,但是你的对象不再存在(即使线程仍然存在)。我发现处理此问题并停止内存泄漏的最简单方法是等待线程在StopMyThread例程中终止,并将销毁FMyThread放入析构函数中(因为如果退出应用程序,则不会调用OnTerminate)。

destructor TMyList.Destroy;
begin
  StopMyThread;


  FreeAndNil(FSomeList);
  FreeAndNil(FMyThread);

  inherited Destroy;
end;

procedure TMyList.StopMyThread;
begin
  FMyThread.Terminate;
  FMyThread.WaitFor;

end;