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

Question

我正在创建一个控制台应用程序，它需要运行多个线程才能完成任务。我的问题是线程正在一个接一个地运行（thread1开始 - >工作 - >结束，然后才开始thread2），而不是在同一时间运行所有线程。此外，我不希望超过10个线程同时工作（性能问题）。 Bellow是控制台应用程序和使用的数据模块的示例代码。我的应用程序正在以同样的方式工作。我已经使用了一个datamodule，因为线程完成后，我必须用这些信息填充数据库。在代码中也有注释，说明哪些是做某事的原因。

应用控制台代码：

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下降到零。

在旁注：通常你不需要用临界区保护局部变量。尽管在那里处理消息可能会导致事情上升，因为它可能会导致重新入侵。

Answer 2

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

Cromis.Threading

里面你有两类：

1. TTaskPool：任务的游泳池。简单的方法来做事异步。
2. TTaskQueue：异步任务队列。像标准的FIFO队列一样工作。

TTaskQueue可以与普通的vanila线程独立使用。它在单个线程内部阻塞并排队请求。

如果这还不够，你可以在检查OmniThreadLibrary：

OmniThreadLibrary

这是一个强大的线程库，远胜于我有什么。但使用起来也比较复杂（但与传统线程相比，仍然非常简单）。

Answer 3

我跟着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会回答我一个关于如何在这个问题上实现信号量的小例子，我会在这里发布整个代码。