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;
posted @ 2013-07-15 17:43  delphi中间件  阅读(4539)  评论(2编辑  收藏  举报