爲什麼線程在這個控制檯應用程序中連續運行？

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會回答我一個關於如何在這個問題上實現信號量的小例子，我會在這裏發佈整個代碼。