Delphi中的多线程

Question

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

带有一个按钮1的主窗体：

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.

每当我通过单击按钮1运行上面的代码时，TExecution实例就会运行，但当我关闭程序时，我会在函数SysFreeMem的GetMem.inc中得到一个访问违规。很明显，代码扰乱了内存，我想这是因为并行内存分配，但我无法找到原因并找到解决方案。我注意到，使用一个线程(NoThreads:=1(，或者使用代码的串行执行(使用单个新线程和5个TExecution实例，或者直接从MainForm创建TExecuttion实例(，我不会遇到类似的内存问题。我的代码有什么问题？非常感谢！

Answer 1

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

将两个变量ExecutionThread和Execution移动到TMainForm1字段，问题就解决了。当然：如果在线程终止之前关闭程序，您将再次遇到麻烦。

另外，反转两行：

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

你必须在睡觉前自由。

BTW：您应该在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.