物件池的設計,可以讓一定頻繁使用到的物件可以重用, 無需不斷進行create/destroy,極大加快了執行效率．

　　下面是一個非常簡單的利用佇列設計而成執行緒安全的通用物件池.

unit uObjPoolUnit;

interface

{
  通用的物件池
  create by rocklee, 9/Jun/2017
  QQ:1927368378
  應用例子：
  FPool := TObjPool.Create(10);  //定義一個最大可以容納10個物件的緩衝物件池
  FPool.OnNewObjectEvent := onNewObject; //定義新建物件的事件
  FPool.setUIThreadID(tthread.CurrentThread.ThreadID); //設定主執行緒的ThreadID
  FPool.WaitQueueSize := 100; //排隊等待的最大上限
  FPool.OnStatusEvent:=onStatus; //status輸出
  ...
  var lvObj:Tobject;
  lvObj := FPool.getObject(); //從池中獲得物件
  ...
  FPool.returnObject(lvObj); //歸還物件

}
uses
  classes, System.Contnrs, forms, sysutils,SyncObjs;

type
  TOnNewObjectEvent = function(): Tobject of object;
  TOnStatusEvent = procedure(const pvStatus: String) of object;

  TObjPool = class(TQueue)
  private
    /// <summary>
    /// 緩衝池大小
    /// </summary>
    fCapacity: Cardinal;
    fSize: Cardinal;
    fUIThreadID: THandle;
    fOnNewObjectEvent: TOnNewObjectEvent;
    fWaitCounter: integer;
    fWaitQueueSize: integer;
    fOnStatusEvent: TOnStatusEvent;
    fLockObj: integer;
    fLock:TCriticalSection;
    function innerPopItem(): Tobject;
    procedure doStatus(const pvStatus: STring);
  public
    procedure Lock;
    procedure UnLock;
    /// <summary>
    /// 當池空時等待的佇列最大數，若超過等待最大數時會直接返回失敗
    /// </summary>
    property WaitQueueSize: integer read fWaitQueueSize write fWaitQueueSize;
    /// <summary>
    /// 從物件池中獲得物件，如果池為空時，會呼叫OnNewObjectEvent新建物件，
    ///
    /// </summary>
    function getObject(pvCurThreadID: THandle = 0): Tobject; virtual;
    /// <summary>
    /// 歸還物件
    /// </summary>
    procedure returnObject(pvObject: Tobject); virtual;
    /// <summary>
    /// 當前池內與借出的物件總共多少
    /// </summary>
    property MntSize: Cardinal read fSize;
    /// <summary>
    /// 當前等待佇列需求量
    /// </summary>
    property CurWaitCounter: integer read fWaitCounter;
    /// <summary>
    /// 獲得當前池裡物件多少
    /// </summary>
    function getPoolSize: integer;
    property OnStatusEvent: TOnStatusEvent read fOnStatusEvent write fOnStatusEvent;
    procedure Clear;
    procedure setUIThreadID(pvThreadID: THandle);
    constructor Create(pvCapacity: Cardinal);
    destructor destroy; override;
    property OnNewObjectEvent: TOnNewObjectEvent read fOnNewObjectEvent
      write fOnNewObjectEvent;

  end;

implementation

procedure SpinLock(var Target: integer);
begin
  while AtomicCmpExchange(Target, 1, 0) <> 0 do
  begin
{$IFDEF SPINLOCK_SLEEP}
    Sleep(1); // 1 對比0 (執行緒越多，速度越平均)
{$ENDIF}
  end;
end;

procedure SpinUnLock(var Target: integer);
begin
  if AtomicCmpExchange(Target, 0, 1) <> 1 then
  begin
    Assert(False, 'SpinUnLock::AtomicCmpExchange(Target, 0, 1) <> 1');
  end;
end;

{ TObjPool }

procedure TObjPool.Clear;
var
  lvObj: Pointer;
  lvCC:integer;
begin
  // 檢查借出去的是否全都歸還
  doStatus(Format('管理物件數:%d,池中物件數%d',[self.MntSize,count]));
  Assert(self.Count = fSize, format('還有%d個物件借出而沒歸還', [MntSize - self.Count]));
  lvCC:=0;
  repeat
    lvObj := innerPopItem();
    if lvObj<>nil then begin
        TObject(lvObj).Destroy;
        INC(lvCC);
    end;
  until lvObj=nil;
  fSize:=0;
  doStatus(format('銷燬%d物件',[lvCC]));
  inherited;
end;

constructor TObjPool.Create(pvCapacity: Cardinal);
begin
  inherited Create;
  fLock:=TCriticalSection.Create;
  fSize := 0;
  fWaitCounter := 0;
  fCapacity := pvCapacity;
  fUIThreadID := 0;
  fLockObj := 0;
  fOnNewObjectEvent := nil;
  fOnStatusEvent := nil;
end;

destructor TObjPool.destroy;
begin
  Clear;
  fLock.Destroy;
  inherited;
end;

procedure TObjPool.doStatus(const pvStatus: STring);
begin
  if (@fOnStatusEvent = nil) then
    exit;
  fOnStatusEvent(pvStatus);
end;

function TObjPool.getObject(pvCurThreadID: THandle = 0): Tobject;
var
  lvCurTheadID: THandle;
begin
  Assert(@fOnNewObjectEvent <> nil, 'OnNewObectEvent is not assigned!');
  result := innerPopItem();
  if result <> nil then
  begin
    exit;
  end;
  if fWaitCounter > fWaitQueueSize then
  begin // 前面排隊數量超過指定上限則退出
    doStatus('前面排隊數量超過指定上限，退出...');
    exit;
  end;

  if fSize = fCapacity then
  begin // 已經達到上限，等待
    // sfLogger.logMessage('排隊等候...');
    doStatus('排隊等候...');
    // InterlockedIncrement(fWaitCounter);
    AtomicIncrement(fWaitCounter);
    if pvCurThreadID <> 0 then
      lvCurTheadID := pvCurThreadID
    else
      lvCurTheadID := TThread.CurrentThread.ThreadID;
    while (result = nil) do
    begin
      if (lvCurTheadID = fUIThreadID) then
      begin
        Application.ProcessMessages;
      end;
      Sleep(1);
      result := innerPopItem();
    end;
    AtomicDecrement(fWaitCounter);
    exit;
  end;
  Lock;
  try
    result := fOnNewObjectEvent();
  finally
    UnLock;
  end;
  AtomicIncrement(fSize);
end;

function TObjPool.getPoolSize: integer;
begin
  result := Count;
end;

function TObjPool.innerPopItem: Tobject;
begin
  Lock;
  try
    if Count=0 then begin
       result:=nil;
       exit;
    end;
    result := Tobject(self.PopItem());
  finally
    UnLock;
  end;
end;

procedure TObjPool.Lock;
begin
  SpinLock(fLockObj);
  //fLock.Enter;
end;
procedure TObjPool.UnLock;
begin
  SpinUnLock(fLockObj);
  //fLock.Leave;
end;

procedure TObjPool.returnObject(pvObject: Tobject);
begin
  Lock;
  try
    self.PushItem(pvObject);
  finally
    UnLock;
  end;
end;

procedure TObjPool.setUIThreadID(pvThreadID: THandle);
begin
  fUIThreadID := pvThreadID;
end;


end.