Delphi中的多线程

Question

我有一个带有 TExecution 类的数字运算应用程序，该类包含在一个单独的单元 Execution.pas 中并执行所有计算。类实例是从程序的主要形式创建的。很多时候 Execution.pas 中的代码需要连续运行 10-15 次，我想在不同的线程中创建几个 TExecution 实例并并行运行它们。简化版代码如下：

其中有一个 Button1 的主窗体：

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Threading, Execution;

type
  TMainForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  MainForm1: TMainForm1;

implementation

{$R *.dfm}

procedure TMainForm1.Button1Click(Sender: TObject);
var
  ExecutionThread: array of TThread;
  NoThreads: integer;
  Execution: array of TExecution;
  thread_ID: integer;
begin
    NoThreads := 5;
    SetLength(Execution,NoThreads);
    SetLength(ExecutionThread,NoThreads);
    //----------------------------------------------------------------------------------
   for thread_ID := 0 to Pred(NoThreads) do
    begin
        ExecutionThread[thread_ID] := TThread.CreateAnonymousThread(
        procedure
        begin
            try
                Execution[thread_ID] := TExecution.Create;
                Execution[thread_ID].CalculateSum;
            finally
                if Assigned(Execution[thread_ID]) then
                begin
                    Execution[thread_ID] := nil;
                    Execution[thread_ID].Free;
                end;
            end;
        end);
        ExecutionThread[thread_ID].FreeOnTerminate := true;
        ExecutionThread[thread_ID].Start;
    end;

end;

end.

Execution.pas 单位：

unit Execution;

interface
uses
System.SysUtils, Vcl.Dialogs, System.Classes, WinApi.Windows;

 type
   TExecution = Class
      const
        NoOfTimes = 1000000;
      var
        Sum: integer;
      private
        procedure IncrementSum(var Sum: integer);
      published
        procedure CalculateSum;
   End;

implementation

procedure TExecution.CalculateSum;
var
  i: integer;
begin
    Sum := 0;
    for i := 0 to Pred(NoofTimes) do
    begin
        IncrementSum(Sum);
    end;
end;

procedure TExecution.IncrementSum(var Sum: integer);
begin
    Inc(Sum);
end;

end.

每当我通过单击 Button1 运行上述代码时，TExecution 实例都会运行，但是当我关闭程序时，我在函数 SysFreeMem 中的 GetMem.inc 中遇到访问冲突。显然，代码弄乱了内存，我猜是因为并行内存分配，但我无法找到原因并解决它。 我注意到，使用一个线程（NoThreads := 1），或串行执行代码（使用单个新线程和 5 个 TExecution 实例，或者直接从 MainForm 创建 TExecution 实例时），我没有得到类似的记忆问题。我的代码有什么问题？ 非常感谢！

Answer 1

问题来自ExecutionThread 和Execution，它们是局部变量。当所有线程都启动时，过程Button1Click 退出，这两个变量在线程终止之前很久就被释放了。

将ExecutionThread 和Execution 这两个变量移动到TMainForm1 字段中，您的问题就会消失。当然：如果你在线程终止之前关闭程序，你又会遇到麻烦。

另外，反转两行：

Execution[thread_ID] := nil;
Execution[thread_ID].Free;

你必须在 niling 之前释放。

顺便说一句：您应该在 TExecution 中收到关于 published 的编译器警告。

编辑： 在对此答案的评论之后，这是同一进程的代码，但使用显式工作线程和通用 TList 来维护正在运行的线程列表。

主窗体的来源：

unit ThreadExecutionDemoMain;

interface

uses
    Winapi.Windows, Winapi.Messages,
    System.SysUtils, System.Variants, System.Classes,
    System.Generics.Collections,
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
    ThreadExecutionDemoExecution,
    ThreadExecutionDemoWorkerThread;

type
    TMainForm = class(TForm)
        StartButton: TButton;
        DisplayMemo: TMemo;
        procedure StartButtonClick(Sender: TObject);
    private
        ThreadList : TList<TWorkerThread>;
        procedure WrokerThreadTerminate(Sender : TObject);
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
    end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

constructor TMainForm.Create(AOwner: TComponent);
begin
    ThreadList := TList<TWorkerThread>.Create;
    inherited Create(AOwner);
end;

destructor TMainForm.Destroy;
begin
    FreeAndNil(ThreadList);
    inherited Destroy;;
end;

procedure TMainForm.StartButtonClick(Sender: TObject);
var
    NoThreads    : Integer;
    ID           : Integer;
    WorkerThread : TWorkerThread;
begin
    NoThreads := 5;
    for ID := 0 to Pred(NoThreads) do begin
        WorkerThread := TWorkerThread.Create(TRUE);
        WorkerThread.ID          := ID;
        WorkerThread.OnTerminate := WrokerThreadTerminate;
        WorkerThread.FreeOnTerminate := TRUE;
        ThreadList.Add(WorkerThread);
        DisplayMemo.Lines.Add(Format('Starting thread %d', [WorkerThread.ID]));
        WorkerThread.Start;
    end;
    DisplayMemo.Lines.Add(Format('There are %d running threads', [ThreadList.Count]));
end;

procedure TMainForm.WrokerThreadTerminate(Sender: TObject);
var
    WorkerThread : TWorkerThread;
begin
    WorkerThread := TWorkerThread(Sender);
    ThreadList.Remove(WorkerThread);
    // This event handler is executed in the context of the main thread
    // we can access the user interface directly
    DisplayMemo.Lines.Add(Format('Thread %d done. Sum=%d',
                                 [WorkerThread.ID, WorkerThread.Sum]));
    if ThreadList.Count = 0 then
        DisplayMemo.Lines.Add('No more running threads');
end;

end.

执行单元的来源：

unit ThreadExecutionDemoExecution;

interface

type
    TExecution = class
    const
        NoOfTimes = 1000000;
    private
        FSum: Integer;
        procedure IncrementSum(var ASum: Integer);
    public
        procedure CalculateSum;
        property Sum: Integer    read  FSum
                                 write FSum;
    end;


implementation

{ TExecution }

procedure TExecution.CalculateSum;
var
    I: Integer;
begin
    FSum := 0;
    for I := 0 to Pred(NoOfTimes) do
        IncrementSum(FSum);
end;

procedure TExecution.IncrementSum(var ASum: Integer);
begin
    Inc(ASum);
end;

end.

工作线程的来源：

unit ThreadExecutionDemoWorkerThread;

interface

uses
    System.SysUtils, System.Classes,
    ThreadExecutionDemoExecution;

type
    TWorkerThread = class(TThread)
    private
        FExecution : TExecution;
        FID        : Integer;
        FSum       : Integer;
    protected
        procedure Execute; override;
    public
        property ID        : Integer    read  FID
                                        write FID;
        property Sum       : Integer    read  FSum
                                        write FSum;
    end;


implementation

{ TWorkerThread }

procedure TWorkerThread.Execute;
begin
    FExecution := TExecution.Create;
    try
        FExecution.CalculateSum;
        FSum := FExecution.Sum;
    finally
        FreeAndNil(FExecution);
    end;
end;

end.