我正在创建一个控制台应用程序,它需要运行多个线程才能完成任务。我的问题是线程一个接一个地运行(线程1开始->工作->结束,然后才启动线程2),而不是同时运行。另外我不希望超过 10 个线程同时工作(性能问题)。Bellow 是控制台应用程序和使用的数据模块的示例代码。我的应用程序以相同的方式工作。我使用了数据模块,因为在线程完成后,我必须用这些信息填充数据库。代码中也有注释解释这是做某事的原因。
应用程序控制台代码:
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 保护,但不会引发错误。
有人可以给我一个建议吗?