Summary Table
Categories |
Total Count |
PII |
0 |
URL |
0 |
DNS |
0 |
EKL |
0 |
IP |
0 |
PORT |
0 |
VsID |
0 |
CF |
0 |
AI |
0 |
VPD |
0 |
PL |
0 |
Other |
0 |
File Content
unit UThreadPool;
interface
uses
Windows, SysUtils, Classes;
const
WT_EXECUTEDEFAULT = DWORD($00000000);
WT_EXECUTEINIOTHREAD = DWORD($00000001);
WT_EXECUTEINUITHREAD = DWORD($00000002);
WT_EXECUTEINWAITTHREAD = DWORD($00000004);
WT_EXECUTEONLYONCE = DWORD($00000008);
WT_EXECUTEINTIMERTHREAD = DWORD($00000020);
WT_EXECUTELONGFUNCTION = DWORD($00000010);
WT_EXECUTEINPERSISTENTIOTHREAD = DWORD($00000040);
WT_EXECUTEINPERSISTENTTHREAD = DWORD($00000080);
WT_TRANSFER_IMPERSONATION = DWORD($00000100);
function QueueUserWorkItem(ThreadFunc: TThreadStartRoutine; Context: Pointer; Flags: DWORD): BOOL; stdcall; external kernel32 name 'QueueUserWorkItem';
type
TThreadPool = class
private
fWorkingThreads: Integer;
fNumberOfThreads: Integer;
procedure QueueWorkItem(Parameters: Pointer; WorkerEvent: TNotifyEvent);
public
function CreateThreadLimitFlag(Limit: DWORD): DWORD;
function AreThreadsWorking: Boolean;
public
property AllTasksFinished: Boolean read AreThreadsWorking;
property NumberOfThreads: Integer read fNumberOfThreads write fNumberOfThreads;
constructor Create(NumberOfThreads: Integer);
procedure AddTask(CallbackFunction: TNotifyEvent; Parameters: Pointer);
end;
TUserWorkItem = class
ThreadBoss: TThreadPool;
Parameters: Pointer;
WorkerEvent: TNotifyEvent;
public
destructor Destroy; override;
end;
implementation
function InternalThreadFunction(lpThreadParameter: Pointer): Integer; stdcall;
begin
Result := 0;
Try
Try
With TUserWorkItem(lpThreadParameter) Do
begin
If Assigned(WorkerEvent) Then
begin
WorkerEvent(Parameters);
InterlockedDecrement(ThreadBoss.fWorkingThreads);
end;
end;
Finally
FreeAndNil(TUserWorkItem(lpThreadParameter));
end;
except
raise;
end;
end;
function TThreadPool.CreateThreadLimitFlag(Limit: DWORD): DWORD;
begin
Result := WT_EXECUTEDEFAULT;
If Not(Limit in [1 .. 255]) Then
Exit;
Result := Result Or (Limit SHL 16);
end;
procedure TThreadPool.QueueWorkItem(Parameters: Pointer; WorkerEvent: TNotifyEvent);
var
WorkItem: TUserWorkItem;
begin
If Assigned(WorkerEvent) Then
begin
IsMultiThread := True;
WorkItem := TUserWorkItem.Create;
Try
WorkItem.ThreadBoss := Self;
WorkItem.WorkerEvent := WorkerEvent;
WorkItem.Parameters := Parameters;
InterlockedIncrement(fWorkingThreads);
If Not(QueueUserWorkItem(InternalThreadFunction, WorkItem, CreateThreadLimitFlag(fNumberOfThreads))) Then
begin
InterlockedDecrement(fWorkingThreads);
RaiseLastOSError;
end;
Except
WorkItem.Free;
raise;
end;
end;
end;
function TThreadPool.AreThreadsWorking: Boolean;
begin
Result := (fWorkingThreads = 0);
end;
constructor TThreadPool.Create(NumberOfThreads: Integer);
begin
inherited Create;
fWorkingThreads := 0;
fNumberOfThreads := NumberOfThreads;
end;
procedure TThreadPool.AddTask(CallbackFunction: TNotifyEvent; Parameters: Pointer);
begin
QueueWorkItem(Parameters, CallbackFunction);
end;
destructor TUserWorkItem.Destroy;
begin
inherited;
end;
end.