KernelMode.info

uses
  System.Types, Generics.Collections, IdMessage;

type
  TThreadItem = class;
  TThreadList = TObjectList;
  TMessageItem = TIdMessage;
  TMessageQueue = TThreadedQueue;

  TThreadPool = class
  private
    FQueue: TMessageQueue;
    FThreads: TThreadList;
  public
    constructor Create(Count: Integer);
    destructor Destroy; override;
    procedure Shutdown;
    property Queue: TMessageQueue read FQueue;
  end;

  TThreadItem = class(TThread)
  private
    FQueue: TMessageQueue;
  protected
    procedure Execute; override;
  public
    constructor Create(Queue: TMessageQueue); reintroduce;
  end;

implementation

{ TThreadPool }

constructor TThreadPool.Create(Count: Integer);
var
  I: Integer;
  Thread: TThreadItem;
begin
  inherited Create;
  { this will create thread queue that will wait for push and pop of its items INFINITE
    time; that's useful for thread sleeping }
  FQueue := TMessageQueue.Create;
  FThreads := TThreadList.Create;

  for I := 0 to Count-1 do
  begin
    Thread := TThreadItem.Create(FQueue);
    FThreads.Add(Thread);
  end;
end;

destructor TThreadPool.Destroy;
begin
  Shutdown;
  FThreads.Free;
  FQueue.Free;
  inherited;
end;

procedure TThreadPool.Shutdown;
var
  Thread: TThreadItem;
  Message: TMessageItem;
begin
  { signal threads for termination }
  for Thread in FThreads do
    Thread.Terminate;
  { shutdown the queue to "unlock" sleeping threads }
  FQueue.DoShutDown;
  { free all the unprocessed enqueued message items }
  Message := FQueue.PopItem;
  while Assigned(Message) do
  begin
    Message.Free;
    Message := FQueue.PopItem;
  end;
end;

{ TThreadItem }

constructor TThreadItem.Create(Queue: TMessageQueue);
begin
  inherited Create;
  FQueue := Queue;
end;

procedure TThreadItem.Execute;
var
  Message: TMessageItem;
begin
  { <- create and setup Indy sending object here }
  try
    while not Terminated do
      { here we'll wait for INFINITE time for an item or until queue is shutted down;
        you should consider checking for error state as well }
      if FQueue.PopItem(Message) = wrSignaled then
      try
        { <- send the Message through the Indy sending object here }
      finally
        Message.Free;
      end;
  finally
    { <- destroy Indy sending object here }
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////

{ Possible usage: }

Pool := TThreadPool.Create(2); { <- create 2 threads }
for I := 0 to 99 do
begin
  Message := TMessageItem.Create(nil);
  Message.Subject := 'Message subject';
  ...
  Pool.Queue.PushItem(Message);
end;

var
   CritSec: RTL_CRITICAL_SECTION;


procedure EnterLock;
begin
    EnterCriticalSection(CritSec);
end;


procedure LeaveLock;
begin
    LeaveCriticalSection(CritSec);
end;


procedure AccessMutualResource;
begin
       EnterLock;
   try
   // Access mutual resource here
   finally
       LeaveLock;
   end;
end;


initialization
     InitializeCriticalSection(CritSec);


finalization
     DeleteCriticalSection(CritSec);