Delphi是否有通用的“對象池”實現？

Question

我在尋找Delphi的數據庫連接池實現時遇到了這個問題。

對象池需要兩種方法：

• get - 從池中獲取一個對象（如果池為空或者其大小未達到其最大大小，這將創建一個新實例），此方法必須是線程安全的，以便兩個線程無法獲取一個對象同一時間。 如果所有對象都在使用，則get方法必須阻止（可能具有可選的超時）

• put - 將對象釋放（返回）到池中

所以用例看起來像

O := Pool.Get;
try
  ... use O
finally
  Pool.Put(O);
end;

更新：添加了Delphi 2009標記，因此Generics.Collections和TMonitor可以成為實現的一部分

Answer 1

TMonitor在Delphi-2009中嚴重破壞。 它在Delphi-XE2 upd 4中變得有用，其答案基於（或更新）。

這里，對象池基於線程安全的TThreadedQueue 。

用於創建池化對象的機制是內置的，具有線程安全性。 從池中獲取對象是線程安全的，並且在池創建時定義了超時。 隊列大小也在池創建時定義，其中也傳遞用於創建對象的回調例程。

uses
  System.Classes,Generics.Collections,System.SyncObjs,System.Diagnostics;

type
  TObjectConstructor = function : TObject;

  TMyPool = Class
  private
    FQueueSize,FAllocatedObjects : integer;
    FGetTimeOut : Integer;
    FQueue : TThreadedQueue<TObject>;
    FObjectConstructor : TObjectConstructor;
    FCS : TCriticalSection;
    function AllocateNewObject : TObject;
  public
    Constructor Create( AnObjectConstructor : TObjectConstructor;
                        QueueSize           : Integer;
                        GetTimeOut          : Integer);
    Destructor Destroy; override;
    procedure Put( const AnObject : TObject);
    function Get( var AnObject : TObject) : TWaitResult;
  End;

function TMyPool.AllocateNewObject: TObject;
begin
  FCS.Enter;
  Try
    if Assigned(FObjectConstructor) and
       (FAllocatedObjects < FQueueSize)
    then
    begin
      Inc(FAllocatedObjects);
      Result := FObjectConstructor;
    end
    else
      Result := Nil;
  Finally
    FCS.Leave;
  End;
end;

constructor TMyPool.Create( AnObjectConstructor : TObjectConstructor;
                            QueueSize           : Integer;
                            GetTimeOut          : Integer);
begin
  Inherited Create;

  FCS := TCriticalSection.Create;
  FAllocatedObjects := 0;
  FQueueSize := QueueSize;
  FObjectConstructor := AnObjectConstructor;
  FGetTimeOut := GetTimeOut;
  FQueue := TThreadedQueue<TObject>.Create(FQueueSize+1,Infinite,10);
  // Adding an extra position in queue to safely remove all items on destroy
end;

destructor TMyPool.Destroy;
var
  AQueueSize : integer;
  AnObject : TObject;
  wr : TWaitResult;
begin
  FQueue.PushItem(Nil); // Just to make sure we have an item in queue
  repeat // Free objects in queue
    AnObject := nil;
    wr := FQueue.PopItem(AQueueSize,AnObject);
    if (wr = wrSignaled) then
      AnObject.Free;
  until (AQueueSize = 0);
  FQueue.Free;
  FCS.Free;

  Inherited;
end;

function TMyPool.Get(var AnObject: TObject) : TWaitResult;
var
  sw : TStopWatch;
begin
  AnObject := nil;
  // If queue is empty, and not filled with enough objects, create a new.
  sw := TStopWatch.Create;
  repeat
    sw.Start;
    Result := FQueue.PopItem( AnObject); // Timeout = 10 ms
    if (Result = wrTimeOut) and
       (FAllocatedObjects < FQueueSize) and
       Assigned(FObjectConstructor)
    then begin  // See if a new object can be allocated
      AnObject := Self.AllocateNewObject;
      if Assigned(AnObject) then
      begin
        Result := wrSignaled;
        Exit;
      end;
    end;
    sw.Stop;
  until (Result = wrSignaled) or (sw.ElapsedMilliseconds > FGetTimeOut);
end;

procedure TMyPool.Put( const AnObject: TObject);
begin
  FQueue.PushItem(AnObject); // Put object back into queue
end;

像這樣定義你的TObjectConstructor函數：

function MyObjectConstructor : TObject;
begin
  Result := TMyObject.Create( {Some optional parameters});
end;

以及如何使用的示例：

var
  AnObject : TObject;
  MyObject : TMyObject;
  wr : TWaitResult;
begin
  wr := MyObjPool.Get(AnObject);
  if (wr = wrSignaled) then 
  begin
    MyObject := TMyObject(AnObject);
    try
      // Do something with MyObject
    finally
      MyObjPool.Put(AnObject);
    end;
  end;
end

Answer 2

根據您在多個線程上執行任務或作業所使用的（線程）平台或體系結構，處理數據庫連接的“通用”方法是使用threadvar和每個線程的數據庫連接。 如果你有一個線程池或線程管理器，它應該擴展為在添加線程時啟動數據庫連接（或在線程上運行的第一個任務上連接到數據庫），並在線程被銷毀時關閉數據庫連接。

Answer 3

Delphi中沒有通用對象池。 您將不得不自己滾動，或使用第三方代碼，例如： delphipooling

Answer 4

今天剛剛遇到了一個迷你對象池的Boosting Work Classes ，由當前dwScript的傑出開發人員Eric提供。

Answer 5

Spring4D - Spring.Container.Pool.pas有一個對象池實現，我還沒試過，但是你知道，Delphi社區的人都知道Spring4D是高質量的:)

似乎沒有文檔，但它有測試用例