Question

我正在创建一个控制台应用程序，它需要运行多个线程才能完成任务。我的问题是线程一个接一个地运行（thread1 start - ＆gt; work - ＆gt; 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降为零。

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

Answer 2

我遵循了Marjan的建议，以下代码似乎正常。我正在回答我自己的问题，以便提供响应代码，可由其他人分析，并在需要时进行更正。

unit Unit1;

interface

uses
  SysUtils, Classes, SyncObjs, Windows, Forms, Dialogs;

var   FCritical: TRTLCriticalSection;  

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;


implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  f                 : TextFile;
  i                 : integer;

begin
 AssignFile(f, 'd:\a\a' + inttostr(FthreadCount) + '.txt');
 if fileexists('d:\a\a' + inttostr(FthreadCount) + '.txt') then
  Append(f)
 else
  Rewrite(f);
   try
    i := 0;
    while i <= 1000000 do
      Inc(i);
  Writeln(f, 'done '+floattostr(self.Handle));
  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;
 try
  while i < 1000 do
  begin
    while (FthreadCount = 10) do
     begin
      Application.ProcessMessages;
      CheckSynchronize
     end;
    CreateThread;
    Inc(i);
  end;
    while FthreadCount > 0 do
    begin
      Application.ProcessMessages;
      CheckSynchronize;
    end;
 except on e:Exception do
//
 end;
end;

end.

此刻我已多次测试此代码，似乎工作正常。如果Rob会回答我一个关于我如何在这个问题上实现信号量的小例子，我也会在这里发布整个代码。

Answer 3

我有一个完全符合你需要的单位。只需从以下网址下载：

Cromis.Threading

你在里面有两个班级：

TTaskPool：任务池。简单的异步方式。
TTaskQueue：异步任务队列。像标准FIFO队列一样工作。

TTaskQueue可以单独使用普通的vanila线程。它阻塞在一个线程内并对请求进行排队。

如果这还不够，您可以在以下位置查看OmniThreadLibrary：

OmniThreadLibrary

这是一个功能强大的线程库，远远优于我所拥有的。但使用起来也更复杂（但与传统线程相比仍然非常容易）。

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

3 个答案: