Tại sao các luồng chạy serially trong ứng dụng giao diện điều khiển này?

Question

Tôi đang tạo một ứng dụng giao diện điều khiển cần chạy nhiều luồng để thực hiện tác vụ. Vấn đề của tôi là các chủ đề đang chạy cái khác (thread1 start -> work -> end và ONLY sau đó bắt đầu thread2) thay vì chạy tất cả cùng một lúc. Ngoài ra tôi không muốn nhiều hơn 10 chủ đề để làm việc trong cùng một thời gian (vấn đề hiệu suất). Dưới đây là một mã ví dụ về ứng dụng giao diện điều khiển và của datamodule được sử dụng. ứng dụng của tôi đang hoạt động theo cách tương tự. tôi đã sử dụng một datamodule bởi vì sau khi các chủ đề được hoàn thành tôi phải điền vào một cơ sở dữ liệu với những thông tin. Ngoài ra còn có ý kiến ​​trong mã để giải thích đó là lý do để làm một cái gì đó.

ứng dụng đang console:

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. 

và datamodule đang

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. 

như vậy, như tôi đã nói vấn đề là chủ đề của tôi đang chạy cái khác, thay vì làm việc tất cả trong cùng một lúc. tôi cũng đã thấy rằng đôi khi chỉ thread đầu tiên làm việc, sau đó tất cả phần còn lại chỉ tạo và hoàn thành. trong ứng dụng của tôi tất cả các mã được bảo vệ bởi try-excepts nhưng không có lỗi nào được nêu ra.

Ai đó có thể cho tôi lời khuyên không?

Answer 1

Ít nhất bạn nên đặt

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

bên ngoài vòng lặp chính. Vòng lặp chờ này là nguyên nhân gây ra sự cố. Đối với mỗi số nguyên i của vòng lặp chính, nó đợi cho đến khi FThreadCount giảm xuống 0.

Trên sidenote: thông thường bạn không cần phải bảo vệ các biến cục bộ với các phần quan trọng. Mặc dù có quá trình thông báo trong đó có thể vít lên vì nó có thể gây ra tái nhập.

Answer 2

Tôi có một đơn vị thực hiện chính xác những gì bạn cần. Chỉ cần tải về từ:

Cromis.Threading

Bên trong, bạn có hai lớp:

1. TTaskPool: Hồ bơi của Tasks. Cách dễ dàng để làm mọi thứ không đồng bộ.
2. TTaskQueue: Hàng đợi các tác vụ không đồng bộ. Hoạt động giống như hàng đợi FIFO tiêu chuẩn.

TTaskQueue có thể được sử dụng độc lập với các chủ đề vanila trơn. Nó chặn bên trong một sợi đơn và xếp hàng các yêu cầu.

Nếu đây không phải là đủ, bạn có thể kiểm tra OmniThreadLibrary tại địa chỉ:

OmniThreadLibrary

Đây là một thư viện luồng mạnh mẽ, cao hơn nhiều so với những gì tôi có. Nhưng cũng phức tạp hơn để sử dụng (nhưng vẫn rất dễ dàng so với luồng cổ điển).

Answer 3

Tôi đã theo dõi đề xuất của Marjan và mã sau dường như hoạt động chính xác. Tôi đang trả lời câu hỏi của riêng tôi để cung cấp mã phản hồi, có thể được phân tích bởi những người khác và sửa chữa nếu cần.

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. 

tại thời điểm này tôi đã thử nghiệm mã này nhiều lần và có vẻ như hoạt động tốt. nếu Rob sẽ trả lời tôi với một ví dụ nhỏ về cách tôi có thể thực hiện semaphores về vấn đề này tôi sẽ đăng toàn bộ mã ở đây cũng có.