Delphi是否有一個通用的「對象池」實現？

Question

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

對象池需要兩個方法：

• GET - 獲取從池中的對象（如果該池是空的或它的規模還沒有達到它的最大尺寸，這將創建一個新的實例），此方法必須是線程安全的，以便一個對象不能同時被兩個線程獲取。如果所有對象都IIN使用GET方法必須阻塞（可能帶有可選超時）

• 放 - 釋放（回報）的對象池

因此，用例看起來像

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

更新：增加了德爾福2009年標記，以便Generics.Collections和TMonitor可能是實現

Answer 1

取決於它（線程）平臺或Ar上的一部分您用於在多個線程上執行任務或作業的結構，處理數據庫連接的「通用」方式是使用threadvar以及每個線程的數據庫連接。如果您有線程池或線程管理器，則應該擴展它以在添加線程時啓動數據庫連接（或者在線程上運行的第一個任務上連接到數據庫），並在線程被銷燬時關閉數據庫連接。

Answer 2

不，Delphi中沒有通用對象池。您必須自行推出，或使用第三方代碼，例如這裏：delphipooling

Answer 3

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 4

跨越今天Boosting Work Classes with a mini Object Pool剛剛來到，由Eric，目前真棒開發商的dwScript。

Answer 5

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

目前似乎沒有有一個文件，但它有test cases here