新年礼物：QSimplePool – 一个简单的通用池对象类实现

首先，恭祝大家新年快乐，万事如意，事业进步。2014已经过去，QDAC 项目感谢有你的支持和陪伴。2014，感谢有你！

为啥叫SimplePool？因为它太简单了，以至于没有足够的整个代码加上系统自动生成的，也不过100多行，所以直接在下面贴出源码分享给大家：

unit QSimplePool;

interface

uses classes, types, sysutils, syncobjs;

type
  TQSimplePool = class;
  TQSimplePoolItemNotify = procedure(ASender: TQSimplePool; AData: Pointer)
    of object;
  TQSimplePoolNewItemEvent = procedure(ASender: TQSimplePool;
    var AData: Pointer) of object;

  TQSimplePool = class
  private
    FOnFree: TQSimplePoolItemNotify;
    FOnNewItem: TQSimplePoolNewItemEvent;
    FOnReset: TQSimplePoolItemNotify;
    FBeforePush: TQSimplePoolItemNotify;
    FAfterPop: TQSimplePoolItemNotify;
  protected
    FPool: array of Pointer;
    FCount: Integer;
    FSize: Integer;
    FDataSize: Integer;
    FLocker: TCriticalSection;
    procedure DoFree(AData: Pointer); // inline;
    procedure DoReset(AData: Pointer); // inline;
    procedure DoNew(var AData: Pointer); // inline;
  public
    constructor Create(AMaxSize, ADataSize: Integer); overload;
    destructor Destroy; override;
    procedure Push(p: Pointer);
    function Pop: Pointer;
    property Count: Integer read FCount;
    property Size: Integer read FSize write FSize;
    property OnNewItem: TQSimplePoolNewItemEvent read FOnNewItem
      write FOnNewItem;
    property OnFree: TQSimplePoolItemNotify read FOnFree write FOnFree;
    property OnReset: TQSimplePoolItemNotify read FOnReset write FOnReset;
    property BeforePush: TQSimplePoolItemNotify read FBeforePush
      write FBeforePush;
    property AfterPop: TQSimplePoolItemNotify read FAfterPop write FAfterPop;
  end;

implementation

{ TQSimplePool }

constructor TQSimplePool.Create(AMaxSize, ADataSize: Integer);
begin
inherited Create;
FSize := AMaxSize;
FDataSize := ADataSize;
SetLength(FPool, FSize);
FLocker := TCriticalSection.Create;
end;

destructor TQSimplePool.Destroy;
var
  I: Integer;
begin
FLocker.Enter;
I := 0;
while I < FCount do
  begin
  DoFree(FPool[I]);
  Inc(I);
  end;
FreeAndNil(FLocker);
inherited;
end;

procedure TQSimplePool.DoFree(AData: Pointer);
begin
if Assigned(FOnFree) then
  FOnFree(Self, AData)
else
  FreeMem(AData);
end;

procedure TQSimplePool.DoNew(var AData: Pointer);
begin
if Assigned(FOnNewItem) then
  FOnNewItem(Self, AData)
else
  GetMem(AData, FDataSize);
end;

procedure TQSimplePool.DoReset(AData: Pointer);
begin
if Assigned(FOnReset) then
  FOnReset(Self, AData)
else
  FillChar(AData^, FDataSize, 0);
end;

function TQSimplePool.Pop: Pointer;
begin
Result := nil;
FLocker.Enter;
if FCount > 0 then
  begin
  Result := FPool[FCount - 1];
  Dec(FCount);
  end;
FLocker.Leave;
if Result = nil then
  DoNew(Result);
if Result <> nil then
  begin
  DoReset(Result);
  if Assigned(FAfterPop) then
    FAfterPop(Self,Result);
  end;
end;

procedure TQSimplePool.Push(p: Pointer);
var
  ADoFree: Boolean;
begin
if Assigned(FBeforePush) then
  FBeforePush(Self, p);
FLocker.Enter;
ADoFree := (FCount = FSize);
if not ADoFree then
  begin
  FPool[FCount] := p;
  Inc(FCount);
  end;
FLocker.Leave;
if ADoFree then
  DoFree(p);
end;

end.

如果将它当作一个内存池使用时，可以简单在构造函数中直接传递内存块的大小进去，然后不要设置OnNewItem、OnFree和OnReset事件的响应函数就可以了。如果要做为对象池，则需要至少响应这三个事件，以满足创建对象、释放对象和重置对象时的需要。

一个当做内存池的简单例子：

var 
  APool:TQSimplePool;
...
APool := TQSimplePool.Create(1024, SizeOf(TOverlapped));
...
//从池中取出一个元素
var
  ov:POverlapped;
...
ov:=APool.Pop;
...
//将元素还回池中
APool.Push(ov);

一个当做对象池的简单例子：

var 
  APool:TQSimplePool;
...
APool := TQSimplePool.Create(1024, 0);
APool.OnNewItem:=DoNewItem;
APool.OnReset:=DoResetItem;
APool.OnFree:=DoFreeItem;
...
procedure TXXX.DoNewItem(ASender:TQSimplePool;var AData:Pointer);
begin
AData:=TStringList.Create;
end;
procedure TXXX.DoResetItem(ASender:TQSimplePool;AData:Pointer)
begin
TStringList(AData).Clear;
end;
procedure TXXX.DoFreeItem(ASender:TQSimplePool;AData:Pointer);
begin
FreeObject(AData);
end;
...
//从池中取出一个元素
var
  AList:TStringList;
...
AList:=APool.Pop;
...
//将元素还回池中
APool.Push(AList);