现在的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.
