delphi新語法之泛型實現的對象池模板

時間  2019-12-05
標籤 delphi 新語 實現 對象 模板 欄目 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;
相關文章
相關標籤/搜索
每日一句
    每一个你不满意的现在，都有一个你没有努力的曾经。
本站公眾號
   歡迎關注本站公眾號,獲取更多信息
聯繫我們 最近搜索 最新文章 沪ICP备13005482号-10 MyBatis教程 SQL 教程 MySQL教程 Java 教程 Thymeleaf 教程 Hibernate教程 Spring教程 Redis教程