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;