delphi - 为什么线程在此控制台应用程序中串行运行？

Question

我正在创建一个控制台应用程序，它需要运行多个线程才能完成任务。我的问题是线程一个接一个地运行(线程1开始->工作->结束，然后才启动线程2)，而不是同时运行所有线程。另外我不希望超过 10 个线程同时工作(性能问题)。下面是控制台应用程序和所使用的数据模块的示例代码。我的应用程序正在以同样的方式工作。我使用了数据模块，因为线程完成后我必须用这些信息填充数据库。代码中也有注释来解释这是做某事的原因。

应用程序控制台代码:

    program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Unit1 in 'Unit1.pas' {DataModule1: TDataModule};

var dm:TDataModule1;
begin
   dm:=TDataModule1.Create(nil);
   try
     dm.execute;
   finally
    FreeAndNil(dm);
   end;
end.

和数据模块代码

    unit Unit1;

interface

uses
  SysUtils, Classes, SyncObjs, Windows, Forms;

var   FCritical: TRTLCriticalSection;//accessing the global variables  

type
  TTestThread = class(TThread)
  protected
    procedure Execute;override;
  end;
  TDataModule1 = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Déclarations privées }
  public

    procedure execute;
    procedure CreateThread();
    procedure Onterminatethrd(Sender: TObject);
  end;

var
  DataModule1       : TDataModule1;
  FthreadCount      : Integer;  //know how many threads are running


implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  f                 : TextFile;
  i                 : integer;
begin
  EnterCriticalSection(fcritical);
  AssignFile(f, 'd:\a' + inttostr(FthreadCount) + '.txt');
  LeaveCriticalSection(fcritical);
  Rewrite(f);
  try
    i := 0;
    while i <= 1000000 do // do some work...
      Inc(i);
    Writeln(f, 'done');
  finally
    CloseFile(f);
  end;
end;

{ TDataModule1 }

procedure TDataModule1.CreateThread;
var
  aThrd             : TTestThread;
begin
  aThrd := TTestThread.Create(True);
  aThrd.FreeOnTerminate := True;
  EnterCriticalSection(fcritical);
  Inc(FthreadCount);
  LeaveCriticalSection(fcritical);
  aThrd.OnTerminate:=Onterminatethrd;
  try
    aThrd.Resume;
  except
    FreeAndNil(aThrd);
  end;
end;

procedure TDataModule1.Onterminatethrd(Sender: TObject);
begin
  EnterCriticalSection(fcritical);
  Dec(FthreadCount);
  LeaveCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin
  InitializeCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleDestroy(Sender: TObject);
begin
  DeleteCriticalSection(fcritical);
end;

procedure TDataModule1.execute;
var
  i                 : integer;
begin
  i := 0;
  while i < 1000 do
  begin
    while (FthreadCount = 10) do
      Application.ProcessMessages;//wait for an thread to finish. max threads at a //time =10

    CreateThread;

    EnterCriticalSection(fcritical);
    Inc(i);
    LeaveCriticalSection(fcritical);

    while FthreadCount > 0 do //wait for all threads to finish in order to close the //main thread
    begin
      Application.ProcessMessages;
      CheckSynchronize;
    end;
  end;
end;

end.

所以，正如我所说，问题是我的线程一个接一个地运行，而不是同时运行。我还看到有时只有第一个线程工作，之后所有其余的线程都创建并完成。在我的应用程序中，所有代码都受 try-excepts 保护，但不会引发任何错误。

有人可以给我建议吗？

Answer 1

至少你应该放

while FthreadCount > 0 do //wait for all threads to finish in order to close the //main thread
begin
  Application.ProcessMessages;
  CheckSynchronize;
end;

在主循环之外。这个等待循环就是导致阻塞的原因。对于主循环的每个整数 i，它都会等待，直到 FThreadCount 降至零。

旁注:通常您不需要使用临界区来保护局部变量。尽管在那里处理消息可能会搞砸事情，因为它可能会导致重新进入。