为什么线程在这个控制台应用程序中串行运行？

Question

我正在创建一个控制台应用程序,它需要运行多个线程才能完成任务.我的问题是线程一个接一个地运行(thread1 start - > work - > end,然后只运行thread2)而不是同时运行所有线程.此外,我不希望超过10个线程同时工作(性能问题).Bellow是控制台应用程序和使用的数据模块的示例代码.我的申请工作方式相同.我使用了数据模块,因为在线程完成后我必须用这些信息填充数据库.在代码中也有注释,这是做某事的原因.

app控制台代码:

    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;

在主循环之外.这个等待循环是导致保持的原因.对于mainloop的每个整数i,它等待直到FThreadCount降为零.

旁注:通常您不需要使用关键部分保护局部变量.虽然在那里有过程消息可能会搞砸,因为它可能会导致重新入侵.