unit ThreadPooler;
interface
uses
Windows, Messages, SysUtils, Classes, SyncObjs, ShellAPI;
//{$DEFINE __EXIT}
type
TPoolerManager = class;
TPoolerThread = class(TThread)
private
FData: Pointer;
FEvent: THandle;
{$IFDEF __EXIT}
FExit: THandle;
{$ENDIF}
FKeepInCache: Boolean;
FManager: TPoolerManager;
procedure HandleException;
protected
function StartThread: Boolean;
function EndThread: Boolean;
procedure Run(Data: Pointer);
virtual;
procedure Execute;
override;
public
constructor Create(CreateSuspended: Boolean;
AManager: TPoolerManager);
destructor Destroy;
override;
procedure ReActive(Data: Pointer);
property Data: Pointer read FData;
property Event: THandle read FEvent;
property KeepInCache: Boolean read FKeepInCache write FKeepInCache;
end;
TThreadEvent = procedure(AThread: TPoolerThread) of object;
TGetThreadEvent = procedure(AManager: TPoolerManager;
var AThread: TPoolerThread) of object;
TPoolerManager = class
private
FMaxCount: Byte;
FThreadEnd: TThreadEvent;
FThreadStart: TThreadEvent;
FList: TList;
FLock: TCriticalSection;
FOnGetThread: TGetThreadEvent;
proceduredo
ThreadStart(Thread: TPoolerThread);
proceduredo
ThreadEnd(Thread: TPoolerThread);
procedure AddThread(Thread: TPoolerThread);
procedure RemoveThread(Thread: TPoolerThread);
procedure SetMaxCount(const Value: Byte);
function GetThreadCount: Integer;
function GetActiveThreadCount: Integer;
function GetItem(const Index: Integer): TPoolerThread;
public
constructor Create;
destructor Destroy;
override;
function GetPoolerThread(Data: Pointer): TPoolerThread;
virtual;
property OnGetThread: TGetThreadEvent read FOnGetThread write FOnGetThread;
property ThreadStart: TThreadEvent read FThreadStart write FThreadStart;
property ThreadEnd: TThreadEvent read FThreadEnd write FThreadend;
property Item[const Index: Integer]: TPoolerThread read GetItem;
property MaxCount: Byte read FMaxCount write SetMaxCount default 10;
property ThreadCount: Integer read GetThreadCount;
property ActiveThreadCount: Integer read GetActiveThreadCount;
end;
implementation
{ TPoolerThread }
constructor TPoolerThread.Create(CreateSuspended: Boolean;
AManager: TPoolerManager);
begin
FManager := AManager;
FKeepInCache := False;
FreeOnTerminate := True;
FEvent := CreateEvent(nil, True, False, nil);
{$IFDEF __EXIT}
FExit := CreateEvent(nil, False, False, nil);
{$ENDIF}
inherited Create(True);
ReActive(nil);
FManager.AddThread(Self);
if not CreateSuspended then
Resume;
end;
destructor TPoolerThread.Destroy;
begin
if Assigned(FManager) then
begin
FManager.RemoveThread(Self);
{$IFDEF __EXIT}
SetEvent(FExit);
{$ENDIF}
end;
CloseHandle(FEvent);
{$IFDEF __EXIT}
CloseHandle(FExit);
{$ENDIF}
inherited Destroy;
end;
function TPoolerThread.EndThread: Boolean;
begin
FData := nil;
Result := Terminated or not FKeepInCache;
end;
function TPoolerThread.StartThread: Boolean;
begin
if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then
ResetEvent(FEvent);
Result := not Terminated and Assigned(FData);
end;
procedure TPoolerThread.HandleException;
var
E: Exception;
begin
E := Exception(ExceptObject);
if E is EAbort then
Exit;
if GetCapture <> 0 then
SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if E is Exception then
begin
if Assigned(ApplicationShowException) then
ApplicationShowException(E);
end else
SysUtils.ShowException(E, nil);
end;
procedure TPoolerThread.Run(Data: Pointer);
begin
// 重载此方法
// 保留一个Data: Pointer作为参数使用
end;
procedure TPoolerThread.ReActive(Data: Pointer);
begin
FData := Data;
SetEvent(FEvent);
end;
procedure TPoolerThread.Execute;
begin
FManager.DoThreadStart(Self);
try
try
while Truedo
begin
if StartThread then
Run(FData);
if EndThread then
break;
end;
except
KeepInCache := False;
Synchronize(HandleException);
end;
finally
FManager.DoThreadEnd(Self);
end;
end;
{ TPoolerManager }
procedure TPoolerManager.AddThread(Thread: TPoolerThread);
begin
FLock.Enter;
try
if FList.IndexOf(Thread) = -1 then
begin
FList.Add(Thread);
Thread.KeepInCache := FList.Count <= FMaxCount;
end;
finally
FLock.Leave;
end;
end;
procedure TPoolerManager.RemoveThread(Thread: TPoolerThread);
begin
FLock.Enter;
try
FList.Remove(Thread);
finally
FLock.Leave;
end;
end;
procedure TPoolerManager.DoThreadEnd(Thread: TPoolerThread);
begin
FLock.Enter;
try
if Assigned(FThreadEnd) then
FThreadEnd(Thread);
finally
FLock.Leave;
end;
end;
procedure TPoolerManager.DoThreadStart(Thread: TPoolerThread);
begin
FLock.Enter;
try
if Assigned(FThreadStart) then
FThreadStart(Thread);
finally
FLock.Leave;
end;
end;
constructor TPoolerManager.Create;
begin
inherited Create;
FLock := TCriticalSection.Create;
FList := TList.Create;
FMaxCount := 10;
end;
destructor TPoolerManager.Destroy;
{$IFDEF __EXIT}
var
I: Integer;
{$ENDIF}
begin
{$IFDEF __EXIT}
for I := FList.Count - 1do
wnto 0do
{do
not localize }
with TPoolerThread(FList)do
begin
Terminate;
ReActive(nil);
WaitForSingleObject(FExit, INFINITE);
end;
{$ENDIF}
FList.Free;
FLock.Free;
inherited Destroy;
end;
function TPoolerManager.GetPoolerThread(Data: Pointer): TPoolerThread;
var
I: Integer;
begin
Result := nil;
FLock.Enter;
try
for I := 0 to FList.Count - 1do
if not Assigned(TPoolerThread(FList).FData) then
begin
Result := FList;
break;
end;
finally
FLock.Leave;
end;
if not Assigned(Result) then
begin
if Assigned(FOnGetThread) then
FOnGetThread(Self, Result);
if not Assigned(Result) then
Result := TPoolerThread.Create(False, Self);
end;
Result.ReActive(Data);
end;
procedure TPoolerManager.SetMaxCount(const Value: Byte);
var
I, Start: Integer;
begin
if FMaxCount <> Value then
begin
if Value < FMaxCount then
Start := Value else
Start := FMaxCount;
FMaxCount := Value;
FLock.Enter;
try
for I := 0 to FList.Count - 1do
TPoolerThread(FList).KeepInCache := I < Start;
finally
FLock.Leave;
end;
end;
end;
function TPoolerManager.GetThreadCount: Integer;
begin
FLock.Enter;
try
Result := FList.Count;
finally
FLock.Leave;
end;
end;
function TPoolerManager.GetActiveThreadCount: Integer;
var
I: Integer;
begin
Result := 0;
FLock.Enter;
try
for I := 0 to FList.Count - 1do
if Assigned(TPoolerThread(FList).FData) then
Inc(Result);
finally
FLock.Leave;
end;
end;
function TPoolerManager.GetItem(const Index: Integer): TPoolerThread;
begin
Result := FList[Index];
end;
end.
