<span style="font-family: Arial, Helvetica, sans-serif;">//</span><span style="font-family: Arial, Helvetica, sans-serif;">http://www.cnblogs.com/DKSoft/p/3564983.html</span>
unit uMyObjectPool;
interface
uses
SyncObjs, Classes, Windows, SysUtils;
type
TObjectBlock = record
private
FObject:TObject;
FUsing:Boolean;
FBorrowTime:Cardinal; //借出时间
FRelaseTime:Cardinal; //归还时间
end;
PObjectBlock = ^TObjectBlock;
TMyObjectPool = class(TObject)
private
FObjectClass:TClass;
FLocker: TCriticalSection;
//全部归还信号
FReleaseSingle: THandle;
//有可用的对象信号灯
FUsableSingle: THandle;
FMaxNum: Integer;
/// <summary>
/// 正在使用的对象列表
/// </summary>
FBusyList:TList;
/// <summary>
/// 可以使用的对象列表
/// </summary>
FUsableList:TList;
FName: String;
FTimeOut: Integer;
procedure makeSingle;
function GetCount: Integer;
procedure lock;
procedure unLock;
protected
/// <summary>
/// 清理空闲的对象
/// </summary>
procedure clear;
/// <summary>
/// 创建一个对象
/// </summary>
function createObject: TObject; virtual;
public
constructor Create(pvObjectClass: TClass = nil);
destructor Destroy; override;
/// <summary>
/// 重置对象池
/// </summary>
procedure resetPool;
/// <summary>
/// 借用一个对象
/// </summary>
function borrowObject: TObject;
/// <summary>
/// 归还一个对象
/// </summary>
procedure releaseObject(pvObject:TObject);
/// <summary>
/// 获取正在使用的个数
/// </summary>
function getBusyCount:Integer;
//等待全部还回
function waitForReleaseSingle: Boolean;
/// <summary>
/// 等待全部归还信号灯
/// </summary>
procedure checkWaitForUsableSingle;
/// <summary>
/// 当前总的个数
/// </summary>
property Count: Integer read GetCount;
/// <summary>
/// 最大对象个数
/// </summary>
property MaxNum: Integer read FMaxNum write FMaxNum;
/// <summary>
/// 对象池名称
/// </summary>
property Name: String read FName write FName;
/// <summary>
/// 等待超时信号灯
/// 单位毫秒
/// </summary>
property TimeOut: Integer read FTimeOut write FTimeOut;
end;
implementation
procedure TMyObjectPool.clear;
var
lvObj:PObjectBlock;
begin
lock;
try
while FUsableList.Count > 0 do
begin
lvObj := PObjectBlock(FUsableList[FUsableList.Count-1]);
lvObj.FObject.Free;
FreeMem(lvObj, SizeOf(TObjectBlock));
FUsableList.Delete(FUsableList.Count-1);
end;
finally
unLock;
end;
end;
constructor TMyObjectPool.Create(pvObjectClass: TClass = nil);
begin
inherited Create;
FObjectClass := pvObjectClass;
FLocker := TCriticalSection.Create();
FBusyList := TList.Create;
FUsableList := TList.Create;
//默认可以使用5个
FMaxNum := 5;
//等待超时信号灯 5 秒
FTimeOut := 5 * 1000;
//
FUsableSingle := CreateEvent(nil, True, True, nil);
//创建信号灯,手动控制
FReleaseSingle := CreateEvent(nil, True, True, nil);
makeSingle;
end;
function TMyObjectPool.createObject: TObject;
begin
Result := nil;
if FObjectClass <> nil then
begin
Result := FObjectClass.Create;
end;
end;
destructor TMyObjectPool.Destroy;
begin
waitForReleaseSingle;
clear;
FLocker.Free;
FBusyList.Free;
FUsableList.Free;
CloseHandle(FUsableSingle);
CloseHandle(FReleaseSingle);
inherited Destroy;
end;
function TMyObjectPool.getBusyCount: Integer;
begin
Result := FBusyList.Count;
end;
{ TMyObjectPool }
procedure TMyObjectPool.releaseObject(pvObject:TObject);
var
i:Integer;
lvObj:PObjectBlock;
begin
lock;
try
for i := 0 to FBusyList.Count - 1 do
begin
lvObj := PObjectBlock(FBusyList[i]);
if lvObj.FObject = pvObject then
begin
FUsableList.Add(lvObj);
lvObj.FRelaseTime := GetTickCount;
FBusyList.Delete(i);
Break;
end;
end;
makeSingle;
finally
unLock;
end;
end;
procedure TMyObjectPool.resetPool;
begin
waitForReleaseSingle;
clear;
end;
procedure TMyObjectPool.unLock;
begin
FLocker.Leave;
end;
function TMyObjectPool.borrowObject: TObject;
var
i:Integer;
lvObj:PObjectBlock;
lvObject:TObject;
begin
Result := nil;
while True do
begin
//是否有可用的对象
checkWaitForUsableSingle;
如果当前有1个可用,100线程同时借用时,都可以直接进入等待成功。
lock;
try
lvObject := nil;
if FUsableList.Count > 0 then
begin
lvObj := PObjectBlock(FUsableList[FUsableList.Count-1]);
FUsableList.Delete(FUsableList.Count-1);
FBusyList.Add(lvObj);
lvObj.FBorrowTime := getTickCount;
lvObj.FRelaseTime := 0;
lvObject := lvObj.FObject;
end else
begin
if GetCount >= FMaxNum then
begin
//如果当前有1个可用,100线程同时借用时,都可以直接(checkWaitForUsableSingle)成功。
continue;
//退出(unLock)后再进行等待....
//raise exception.CreateFmt('超出对象池[%s]允许的范围[%d]', [self.ClassName, FMaxNum]);
end;
lvObject := createObject;
if lvObject = nil then raise exception.CreateFmt('不能得到对象,对象池[%s]未继承处理createObject函数', [self.ClassName]);
GetMem(lvObj, SizeOf(TObjectBlock));
try
ZeroMemory(lvObj, SizeOf(TObjectBlock));
lvObj.FObject := lvObject;
lvObj.FBorrowTime := GetTickCount;
lvObj.FRelaseTime := 0;
FBusyList.Add(lvObj);
except
lvObject.Free;
FreeMem(lvObj, SizeOf(TObjectBlock));
raise;
end;
end;
//设置信号灯
makeSingle;
Result := lvObject;
//获取到
Break;
finally
unLock;
end;
end;
end;
procedure TMyObjectPool.makeSingle;
begin
if (GetCount < FMaxNum) //还可以创建
or (FUsableList.Count > 0) //还有可使用的
then
begin
//设置有信号
SetEvent(FUsableSingle);
end else
begin
//没有信号
ResetEvent(FUsableSingle);
end;
if FBusyList.Count > 0 then
begin
//没有信号
ResetEvent(FReleaseSingle);
end else
begin
//全部归还有信号
SetEvent(FReleaseSingle)
end;
end;
function TMyObjectPool.GetCount: Integer;
begin
Result := FUsableList.Count + FBusyList.Count;
end;
procedure TMyObjectPool.lock;
begin
FLocker.Enter;
end;
function TMyObjectPool.waitForReleaseSingle: Boolean;
var
lvRet:DWORD;
begin
Result := false;
lvRet := WaitForSingleObject(FReleaseSingle, INFINITE);
if lvRet = WAIT_OBJECT_0 then
begin
Result := true;
end;
end;
procedure TMyObjectPool.checkWaitForUsableSingle;
var
lvRet:DWORD;
begin
lvRet := WaitForSingleObject(FUsableSingle, FTimeOut);
if lvRet <> WAIT_OBJECT_0 then
begin
raise Exception.CreateFmt('对象池[%s]等待可使用对象超时(%d),使用状态[%d/%d]!',
[FName, lvRet, getBusyCount, FMaxNum]);
end;
end;
end.
http://www.cnblogs.com/hnxxcxg/archive/2013/07/15/3191622.html
// 标准模板
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;