• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
现在的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

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
MATLAB中函数调用 - *简单就好*发布时间：2022-07-18
下一篇：
用Delphi改变图片的像素,即大小发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap