Delphi 中的多线程
multithreading in Delphi
我有一个带有 TExecution class 的数字 c运行ching 应用程序，它包含在一个单独的单元 Execution.pas 中并执行所有计算。 class 个实例是从程序的主窗体创建的。通常 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.
每当我通过单击 TExecution 实例 运行 上的 Button1 来 运行 上面的代码时，但是当我关闭程序时，我会在 GetMem.inc 函数 SysFreeMem 中遇到访问冲突。显然，代码弄乱了内存，我猜是因为并行内存分配，但我无法找到原因并修复它的解决方案。
我注意到，对于一个线程（NoThreads := 1），或代码的串行执行（使用一个新线程和 5 个 TExecution 实例，或者当 TExecution 的实例直接从 MainForm 创建时），我没有得到类似的内存问题。我的代码有什么问题？
非常感谢！
问题来自 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.
我有一个带有 TExecution class 的数字 c运行ching 应用程序，它包含在一个单独的单元 Execution.pas 中并执行所有计算。 class 个实例是从程序的主窗体创建的。通常 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.
每当我通过单击 TExecution 实例 运行 上的 Button1 来 运行 上面的代码时，但是当我关闭程序时，我会在 GetMem.inc 函数 SysFreeMem 中遇到访问冲突。显然，代码弄乱了内存，我猜是因为并行内存分配，但我无法找到原因并修复它的解决方案。 我注意到，对于一个线程（NoThreads := 1），或代码的串行执行（使用一个新线程和 5 个 TExecution 实例，或者当 TExecution 的实例直接从 MainForm 创建时），我没有得到类似的内存问题。我的代码有什么问题？ 非常感谢！
问题来自 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.