delphi新语法之泛型实现的对象池模板

现在的DELPHI因为支持泛型的语法，所以也能支持模板编程了。

 

// 标准模板

unit UntPools;

 

interface

 

uses

  Classes, SysUtils, UntThreadTimer;

 

type

  { 这是一个对像池, 可以池化所有 TObject 对像 }

  { 用法:

       在一个全局的地方定义

    var

       Pooler: TObjectPool;

 

    用到的地方

       obj := Pooler.LockObject as Txxx;

       try

       finally

         Pooler.UnlockObject;

       end;

 

    初始化

    initialization

       Pooler := TObjectPool.Create(要收集的类名)

    finallization

       Pooler.Free;

    end;

  }

  //池中对象 状态

  TPoolItem = class

  private

    FInstance: TObject; //对象

    FLocked: Boolean; //是否被使用

    FLastTime:TDateTime;//最近活跃时间

  public

    constructor Create(AInstance: TObject;const IsLocked :Boolean = True);

    destructor Destroy; override;

  end;

  //对象池

  TObjectPool = class

  private

    FCachedList: TThreadList;//对象池 中 对象 列表

    FMaxCacheSize,FMinCacheSize: Integer; //对象池最大值，最小值  如不设置系统默认为 20

    FCacheHit: Cardinal; //调用对象池 中 对象的 次数

    FCreationCount: Cardinal; //创建对象次数

    FObjectClass: TClass;

    FRequestCount: Cardinal; //调用对象池次数

    FAutoReleased: Boolean; //自动释放空闲的对象

    FTimer:TThreadedTimer; //多线程计时器

    FHourInterval:Integer;  //设置间隔时间（小时）

    function GetCurObjCount:Integer;

    function GetLockObjCount:Integer;

    procedure IniMinPools;//初始化最小池对象

    procedure SetFHourInterval(iValue:Integer);

  protected

    function CreateObject: TObject;// 创建对象

    procedure OnMyTimer(Sender: TObject);

  public

    constructor Create(AClass: TClass;MaxPools,MinPools:Integer);

    destructor Destroy; override;

 

    function LockObject: TObject;//获取对象

    procedure UnlockObject(Instance: TObject); //释放对象

 

 

    property ObjectClass: TClass read FObjectClass;

    property MaxCacheSize: Integer read FMaxCacheSize;//池子大小

    property CacheHit: Cardinal read FCacheHit; //调用池子中对象次数

    property CreationCount: Cardinal read FCreationCount;//创建对象次数

    property RequestCount: Cardinal read FRequestCount;//请求池次数

    property RealCount : Integer  read GetCurObjCount;//池中对象数量

    property LockObjCount: Integer read GetLockObjCount;//池子繁忙的对象数量

    property HourInterval: Integer read FHourInterval write SetFHourInterval;

    procedure StartAutoFree; //开启自动回收

    procedure StopAutoFree; //关闭自动回收

  end;

 

  { TObjectPool<T> }

  { 同样是对像池, 但支持模板 }

  { 用法:

       在一个全局的地方定义

    var

       Pooler: TObjectPool<要收集的类名>;

 

    用到的地方

       obj := Pooler.LockObject;

       try

 

       finally

 

         Pooler.UnlockObject;

       end;

 

    初始化

 

    initialization

       Pooler := TObjectPool<要收集的类名>.Create;

    finallization

       Pooler.Free;

    end;

  }

  TObjectPool<T: class> = class(TObjectPool)

  public

    constructor Create(const MaxPools:Integer = 0;const MinPools:Integer = 0);

 

    function LockObject: T;

  end;

 

implementation

 

{TPoolItem }

 

const

  MSecsPerMins = SecsPerMin * MSecsPerSec;

  //返回相差的分钟

  function MyMinutesBetWeen(const ANow, AThen: TDateTime): Integer;

  var

    tmpDay:Double;

  begin

    tmpDay := 0;

    if ANow < AThen then

      tmpDay := AThen - ANow

    else

      tmpDay := ANow - AThen;

    Result := Round(MinsPerDay * tmpDay);

  end;

 

constructor TPoolItem.Create(AInstance: TObject;const IsLocked :Boolean);

begin

  inherited Create;

  FInstance := AInstance;

  FLocked := IsLocked;

  FLastTime := Now;

end;

 

destructor TPoolItem.Destroy;

begin

  if Assigned(FInstance) then FreeAndNil(FInstance);

  inherited;

end;

 

{ TObjectPool }

constructor TObjectPool.Create(AClass: TClass; MaxPools, MinPools: Integer);

begin

  inherited Create;

  FObjectClass := AClass;

  FCachedList := TThreadList.Create;

  FMaxCacheSize := MaxPools;

  FMinCacheSize := MinPools;

  if FMaxCacheSize = 0 then FMaxCacheSize := 20;  //系统默认为20个并发

  if FMinCacheSize > FMaxCacheSize then FMinCacheSize := FMaxCacheSize;//系统默认最小值为0

  FCacheHit := 0;

  FCreationCount := 0;

  FRequestCount := 0;

  IniMinPools; //初始化最小池对象

  //计时销毁

  FTimer := TThreadedTimer.Create(nil); //计时

  FHourInterval := 4; //默认空闲4小时则回收

  FTimer.Interval := MSecsPerMins * MinsPerHour * FHourInterval;

  FTimer.OnTimer := OnMyTimer;

end;

 

function TObjectPool.CreateObject: TObject;

begin

  Result := FObjectClass.NewInstance;

  if Result is TDataModule then

    TDataModule(Result).Create(nil)

  else if Result is TComponent then

    TComponent(Result).Create(nil)

  else if Result is TPersistent then

    TPersistent(Result).Create

  else Result.Create;

end;

 

destructor TObjectPool.Destroy;

var

  I: Integer;

  LockedList: TList;

begin

  if Assigned(FCachedList) then

  begin

    LockedList := FCachedList.LockList;

    try

      for I := 0 to LockedList.Count - 1 do

        TPoolItem(LockedList[I]).Free;

    finally

      FCachedList.UnlockList;

      FCachedList.Free;

    end;

  end;

  FTimer.Free;

  inherited;

end;

 

function TObjectPool.GetCurObjCount: Integer;

var

  LockedList: TList;

begin

  Result := 0;

  LockedList := FCachedList.LockList;

  try

    Result := LockedList.Count;

  finally

    FCachedList.UnlockList;

  end;

end;

 

function TObjectPool.GetLockObjCount: Integer;

var

  LockedList: TList;

  i:Integer;

begin

  Result := 0;

  LockedList := FCachedList.LockList;

  try

    for I := 0 to LockedList.Count - 1 do

    begin

      if TPoolItem(LockedList[I]).FLocked then Result := Result + 1;

    end;

  finally

    FCachedList.UnlockList;

  end;

end;

 

procedure TObjectPool.IniMinPools;

var

  PoolsObject: TObject;

  LockedList: TList;

  I: Integer;

begin

  LockedList := FCachedList.LockList;

  try

    for I := 0 to FMinCacheSize - 1 do

    begin

      PoolsObject := CreateObject;

      if Assigned(PoolsObject) then

        LockedList.Add(TPoolItem.Create(PoolsObject,False));

    end;

  finally

    FCachedList.UnlockList;

  end;

end;

 

function TObjectPool.LockObject: TObject;

var

  LockedList: TList;

  I: Integer;

begin

  Result := nil;

  LockedList := FCachedList.LockList;

  try

    Inc(FRequestCount);

    for i := 0 to LockedList.Count - 1 do

    begin

      if not TPoolItem(LockedList.Items[i]).FLocked then

      begin

        Result := TPoolItem(LockedList.Items[i]).FInstance;

        TPoolItem(LockedList.Items[i]).FLocked := True;

        TPoolItem(LockedList.Items[i]).FLastTime := Now;

        Inc(FCacheHit);//从池中取的次数

        Break;

      end;

    end;

    //

    if not Assigned(Result) then

    begin

      Result := CreateObject;

      //Assert(Assigned(Result));

      Inc(FCreationCount);

      if LockedList.Count < FMaxCacheSize then //池子容量

        LockedList.Add(TPoolItem.Create(Result,True));

    end;

  finally

    FCachedList.UnlockList;

  end;

end;

 

procedure TObjectPool.OnMyTimer(Sender: TObject);

var

  i:Integer;

  LockedList: TList;

begin

  LockedList := FCachedList.LockList;

  try

    for I := LockedList.Count - 1 downto 0 do

    begin

      if MyMinutesBetween(Now,TPoolItem(LockedList.Items[i]).FLastTime) >= FHourInterval * MinsPerHour then //释放池子许久不用的ADO

      begin

        TPoolItem(LockedList.Items[i]).Free;

        LockedList.Delete(I);

      end;

    end;

  finally

    FCachedList.UnlockList;

  end;

end;

 

procedure TObjectPool.SetFHourInterval(iValue: Integer);

begin

  if iValue <= 1 then Exit;

  if FHourInterval = iValue then Exit;

  FTimer.Enabled := False;

  try

    FHourInterval := iValue;

    FTimer.Interval := MSecsPerMins * MinsPerHour * FHourInterval;

  finally

    FTimer.Enabled := True;

  end;

end;

 

procedure TObjectPool.StartAutoFree;

begin

  if not FTimer.Enabled then FTimer.Enabled := True;

end;

 

procedure TObjectPool.StopAutoFree;

begin

  if FTimer.Enabled then FTimer.Enabled := False;

end;

 

procedure TObjectPool.UnlockObject(Instance: TObject);

var

  LockedList: TList;

  I: Integer;

  Item: TPoolItem;

begin

  LockedList := FCachedList.LockList;

  try

    Item := nil;

    for i := 0 to LockedList.Count - 1 do

    begin

      Item := TPoolItem(LockedList.Items[i]);

      if Item.FInstance = Instance then

      begin

        Item.FLocked := False;

        Item.FLastTime := Now;

        Break;

      end;

    end;

    if not Assigned(Item) then Instance.Free;

  finally

    FCachedList.UnlockList;

  end;

end;

 

// 基于标准模板定义的泛型模板

{ TObjectPool<T> }

constructor TObjectPool<T>.Create(const MaxPools, MinPools: Integer);

begin

  inherited Create(T,MaxPools,MinPools);

end;

 

function TObjectPool<T>.LockObject: T;

begin

  Result := T(inherited LockObject);

end;

 

end.

 

// 基于泛型模板定义的具体模板

var

  FQueryMgr:TObjectPool<TUniQuery>; //Query池子

  FDspMgr:TObjectPool<TDataSetProvider>;//DSP池子

  FCDSMgr:TObjectPool<TClientDataSet>;//cds池子

  FDSMgr :TObjectPool<TDataSource>;//ds池子

  FUniSQLMgr:TObjectPool<TUniSQL>;//执行SQL池子

  FUniSPMgr :TObjectPool<TUniStoredProc>;//存储过程池子

 

// 创建具体模板

function QueryMgr:TObjectPool<TUniQuery>;

begin

  if not Assigned(FQueryMgr) then

    FQueryMgr := TObjectPool<TUniQuery>.Create(1000,20);

  Result := FQueryMgr;

end;

http://www.vckbase.com/module/articleContent.php?id=4386