首页 > 其他分享 >通用模板对象池-转载

通用模板对象池-转载

时间：2022-11-07 09:00:24浏览次数：92  
标签：begin end TObjectPool Create Result 通用 转载 LockedList 模板

一个很好用的对象池，分享一下，原文链接：https://www.cnblogs.com/hnxxcxg/p/3191622.html

// 标准模板
unit uObjPools;

interface

uses
Classes, SysUtils, UntThreadTimer, Vcl.Forms, IniFiles,
FireDAC.Comp.Client, FireDAC.Phys.MSSQL, FireDAC.Moni.FlatFile,
FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Stan.Def,
FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait,
Data.DB, FireDAC.DApt,uConfig,
FireDAC.Phys.SQLite,
FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteWrapper.Stat;

type
TDBConfig = class
private
//数据库配置
Driver:string; //驱动类型
DBServer: string; //数据源 --数据库服务器IP
DataBase: string; //数据库名字 //sql server连接时需要数据库名参数--数据库实例名称
UserName: string; //数据库用户
PassWord: string; //密码
PoolNum: Integer; //池大小
public
constructor Create(aDriver: string); overload;
destructor Destroy; override;
end;
{ 这是一个对像池, 可以池化所有 TObject 对像 }
{ 用法:
在一个全局的地方定义
var
Pooler: TObjectPool;

用到的地方
obj := Pooler.GetObj as Txxx;
try
finally
Pooler.PutObj;
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
FConfig:TDBConfig;
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; Config:TDBConfig);
destructor Destroy; override;

function GetObj: TObject; //获取对象
procedure PutObj(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.GetObj;
try

finally

Pooler.PutObj;
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;const Config:TDBConfig = nil);

function GetObj: T;
end;


var
DBConfig,SQLiteConfig: TDBConfig;
// 基于泛型模板定义的具体模板
FQryPool: TObjectPool<TFDQuery>; //Query池子
FDBPool: TObjectPool<TFDConnection>; //Database池子
FListPool:TObjectPool<TStringList>; //List池子
{FProcMgr: TObjectPool<TFDStoredProc>; //Database池子
FDspMgr:TObjectPool<TDataSetProvider>;//DSP池子
FCDSMgr:TObjectPool<TClientDataSet>;//cds池子
FDSMgr :TObjectPool<TDataSource>;//ds池子
FUniSQLMgr:TObjectPool<TUniSQL>;//执行SQL池子
FUniSPMgr :TObjectPool<TUniStoredProc>;//存储过程池子 }

function QryPool: TObjectPool<TFDQuery>;
function DBPool: TObjectPool<TFDConnection>;
function ListPool: TObjectPool<TStringList>;

implementation

// 创建具体模板
function QryPool: TObjectPool<TFDQuery>;
begin
if not Assigned(FQryPool) then
FQryPool := TObjectPool<TFDQuery>.Create(DBConfig.PoolNum * 10, DBConfig.PoolNum);
Result := FQryPool;
end;

function DBPool: TObjectPool<TFDConnection>;
begin
if not Assigned(FDBPool) then
FDBPool := TObjectPool<TFDConnection>.Create(DBConfig.PoolNum, 1,DBConfig);
Result := FDBPool;
end;

function ListPool: TObjectPool<TStringList>;
begin
if not Assigned(FListPool) then
FListPool := TObjectPool<TStringList>.Create(DBConfig.PoolNum * 10, DBConfig.PoolNum);
Result := FListPool;
end;

 

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;Config:TDBConfig);
begin
inherited Create;
FConfig := Config;
if FConfig = nil then
FConfig := DBConfig;
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(Application.Handle, nil); //计时
FHourInterval := 1; //默认空闲1小时则回收
FTimer.Interval := SecsPerMin * MinsPerHour * FHourInterval;
FTimer.OnTimer := OnMyTimer;
FTimer.Enabled := True;
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;
if (Result is TFDConnection) then
begin
var str := 'DriverID='+FConfig.Driver+';Database=' + FConfig.DataBase
+ ';Password=' + FConfig.PassWord;
if FConfig.Driver = 'MSSQL' then
str := str+';User_name=' + FConfig.UserName+';Server=' + FConfig.DBServer;
with TFDConnection(Result) do
begin
//ConnectionTimeout:=18000;
ConnectionString := str;
//解决执行sql过程断线，等待时间过程 ,加上之后，数据量过大写入会超时！屏蔽！
//Params.add('ResourceOptions.CmdExecTimeout=3');
//解决查询只返回50条数据问题
Params.add('FetchOptions.Mode=fmAll');
//解决！，&等字符插入数据库时丢失
Params.add('ResourceOptions.MacroCreate=False');
Params.add('ResourceOptions.MacroExpand=False');
try
Connected := True;
except
raise Exception.Create('数据库连接失败！请检查数据库配置或者网络链接！');
end;
end;
end;
end;

destructor TObjectPool.Destroy;
var
I: Integer;
LockedList: TList;
begin
FTimer.Enabled := False;
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.GetObj: TObject;
var
LockedList: TList;
I: Integer;
CurOutTime: Integer;
begin
Result := nil;
CurOutTime := 0;
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
//池未满，新建对象
if LockedList.Count < FMaxCacheSize then //池子容量
begin
Result := CreateObject;
Inc(FCreationCount);
LockedList.Add(TPoolItem.Create(Result, True));
end
//池满 等待对象释放 超时设置成30秒
else
begin
while True do
begin
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 CurOutTime >= 5000 * 6 then //30s
begin
raise Exception.Create('池中寻找可用对象超时！请重新提交业务！');
Break;
end;
Sleep(500); //0.5秒钟
CurOutTime := CurOutTime + 500; //超时设置成30秒
end; //end while
end;
end;

finally
if Result is TFDQuery then
TFDQuery(Result).Close;
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 RealCount <= FMinCacheSize then Exit;
//释放池子许久不用的对象
if MyMinutesBetween(Now, TPoolItem(LockedList.Items[i]).FLastTime) >= FHourInterval * MinsPerHour then
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.PutObj(Instance: TObject);
var
LockedList: TList;
I: Integer;
Item: TPoolItem;
CurOutTime: Integer;
begin
LockedList := FCachedList.LockList;
try
Item := nil;
CurOutTime := 0;
for I := 0 to LockedList.Count - 1 do
begin
Item := TPoolItem(LockedList.Items[I]);
if Item.FInstance = Instance then
begin
if Instance is TFDQuery then
TFDQuery(Instance).Connection := nil;
if Instance is TStringList then
TStringList(Instance).Clear;
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;const Config:TDBConfig);
begin
inherited Create(T, MaxPools, MinPools,Config);
end;

function TObjectPool<T>.GetObj: T;
begin
Result := T(inherited GetObj);
end;

{ TDBConfig }

constructor TDBConfig.Create(aDriver: string);
begin
if aDriver = 'MSSQL' then
begin
Driver := 'MSSQL';
DBServer := Ini.DBServer;
DataBase := Ini.DBDataBase;
UserName := Ini.DBUserName;
PassWord := Ini.DBPassWord;
end
else if aDriver = 'SQLite' then
begin
Driver := 'SQLite';
DataBase := ChangeFileExt(ParamStr(0), '.db');
PassWord := 'yxsoft';
end;
PoolNum := Ini.Pools;
end;

destructor TDBConfig.Destroy;
begin

inherited;
end;

initialization
DBConfig := TDBConfig.Create('MSSQL');

finalization
if Assigned(DBConfig) then
DBConfig.Free;
if Assigned(FQryPool) then
FQryPool.Free;
if Assigned(FDBPool) then
FDBPool.Free;
if Assigned(FListPool) then
FListPool.Free;

end.

 

(*


自己编写的线程计时器，没有采用消息机制，很有效

Cobbler续写

不用 TTimer 的原因:

要说TTimer类的使用问题，先要说一下它响应用户定义的回调函数(OnTimer)的方法。
TTimer拥有一个HWnd类型的成员变量FWindowHandle，用于捕捉系统消息。
TTimer在Enable的情况下，每隔Interval时间，就抛一个系统消息WM_TIMER,FWindowHandle捕捉到这个消息后，
就会执行用户的回调函数，实现用户需要的功能。就是这个消息机制引发了下面两个问题：

问题1: 还不算严重，TTimer与系统共用一个消息队列，也就是说，在用户回调函数处理完之前，
所有的系统消息都处于阻塞状态，包括界面的更新的消息。
如果你的回调函数瞬间执行完毕那就一切看着还正常，如果你要执行一个复杂耗时的操作，
比如数据库查询什么的（万一遇到数据库联接不正常，等待20秒），
那你的界面就必死无疑，直到回调函数执行完。如果是后台系统还好，
要是给用户使用的就没法交待了。即使你在子线程里面使用也不会解决的。

问题2: 一般系统定义消息的优先级比用户定义消息的优先级要低。
在子线程中使用TTimer时，如果线程间通信也大量使用自定义消息，
并且用户定义自己的消息处理函数，那WM_TIMER经常就会被丢弃了，
计时器就彻底失效了。

摘抄自网络

*)

unit UntThreadTimer;

interface

uses
Windows, Classes, Winapi.Messages;

type
TTimerStatus = (TS_ENABLE, TS_CHANGEINTERVAL, TS_DISABLE, TS_SETONTIMER);
TThreadedTimer = class;
TTimerThread = class;
PTimerThread = ^TTimerThread;

TTimerThread = class(TThread)
OwnerTimer: TThreadedTimer;
Interval: DWord;
Enabled: Boolean;
Status: TTimerStatus;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Execute; override;
procedure DoTimer;
end;

TThreadedTimer = class(TComponent)
private
FHandle: THandle;
FEnabled: Boolean;
FInterval: DWord;
FOnTimer: TNotifyEvent;
FTimerThread: TTimerThread;
FThreadPriority: TThreadPriority;
protected
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetInterval(Value: DWord);
procedure SetOnTimer(Value: TNotifyEvent);
procedure Timer; dynamic;
public
constructor Create(AHandle: THandle; AOwner: TComponent);
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled default True;
property Interval: DWord read FInterval write SetInterval default 1000;
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
end;

implementation

procedure WakeupDownThrdproc(const evenFlag: Integer); stdcall;
begin

end;

{ TTimerThread }
constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
Interval := 1000;
Enabled := False;
Status := TS_DISABLE;
end;

destructor TTimerThread.Destroy;
begin
inherited;
end;

procedure TTimerThread.Execute;
begin
inherited;
while not Terminated do
begin
// SleepEx(Interval, True);
if (not Terminated) and (Status = TS_ENABLE) then
Synchronize(DoTimer);
if Status <> TS_ENABLE then
begin
case Status of
TS_CHANGEINTERVAL:
begin
Status := TS_ENABLE;
SleepEx(0, True);
end;
TS_DISABLE:
begin
Status := TS_ENABLE;
SleepEx(0, True);
if not Terminated then
Suspend;
end;
TS_SETONTIMER:
begin
Status := TS_ENABLE;
end
else
Status := TS_ENABLE;
end;
end;
SleepEx(Interval, True);
end;
end;

procedure TTimerThread.DoTimer;
begin
OwnerTimer.Timer;
end;

{ TThreadedTimer }
constructor TThreadedTimer.Create(AHandle: THandle; AOwner: TComponent);
begin
inherited Create(AOwner);
FHandle := AHandle;
FInterval := 1000;
FThreadPriority := tpNormal;
FTimerThread := TTimerThread.Create(True);
FTimerThread.OwnerTimer := self;
end;

destructor TThreadedTimer.Destroy;
begin
inherited Destroy;
FTimerThread.Terminate;
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWord(FTimerThread));
FTimerThread.Free;
end;

procedure TThreadedTimer.UpdateTimer;
begin
if (FEnabled = False) then
begin
FTimerThread.OwnerTimer := self;
FTimerThread.Interval := FInterval;
FTimerThread.Priority := FThreadPriority;
FTimerThread.Resume;
end;
if (FEnabled = True) then
begin
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWord(FTimerThread));
end;
end;

procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
if Value then
begin
FTimerThread.Status := TS_ENABLE;
FTimerThread.Resume;
end
else
begin
FTimerThread.Status := TS_DISABLE;
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle,
DWord(FTimerThread));
end;
end;
end;

procedure TThreadedTimer.SetInterval(Value: DWord);
begin
if Value <> FInterval then
begin
if (not Enabled) then
begin
FInterval := Value;
FTimerThread.Interval := FInterval;
end
else
begin
FInterval := Value;
FTimerThread.Interval := FInterval;
FTimerThread.Status := TS_CHANGEINTERVAL;
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle,
DWord(FTimerThread));
end;
end;
end;

procedure TThreadedTimer.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
end;

procedure TThreadedTimer.Timer;
var
Msg: TMessage;
begin
Msg.Msg := WM_USER + 100;
if Assigned(FOnTimer) then FOnTimer(Self);
PostMessage(FHandle, Msg.Msg, 0, 0);
end;

end.

 

标签：begin,end,TObjectPool,Create,Result,通用,转载,LockedList,模板
From： https://www.cnblogs.com/Yang-YaChao/p/16864855.html

相关文章

  • 转载-Troubleshooting .NET Blazor WASM Debugging
    Troubleshooting.NETBlazorWASMDebugging Soyou’vedecidedtoboltonanexistingBlazorWebAssembly(WASM)UItoacurrentASP.NETCoresolution.First......
  • 【模板】广义后缀自动机 exSAM
    postedon2022-11-0218:51:48|under模板|sourcesolution膜拜@xzzduang。我们重学一个SAM。一个点维护的是所有\(endpos=S\)的（本质不同的）串，显然这些串的长度......
  • 【模板】二元一次不定方程 exgcd
    postedon2022-09-1715:59:26|under模板|sourcecodeLLmod(LLx,LLm){return(x%m+m)%m;}LLexgcd(LLa,LLb,LLc,LL&x,LL&y){ if(!b)returnx=c/a,y=0,a;......
  • 【模板】二维数点
    postedon2022-10-2313:50:24|under模板|sourceproblem给定一个二维平面，多次询问\(x\in[l_x,r_x],y\in[l_y,r_y]\)的点有多少个。solution1（静态+在线）：可持久化......
  • 【模板】网络流
    postedon2022-08-1214:14:05|under模板|source感谢讲师LQS带来的网络流专题。本文非常不严谨，请不要把它当作入门博客。0xFF目录0x00网络流及求法0x01......
  • 【模板】多项式乘法 FFT
    postedon2022-08-0223:57:12|under模板|source涉世不深，不会卡常，恳求大佬指教typedefcomplex<double>comp;constdoublePI=acos(-1);template<intN>struct......
  • 【模板】对拍
    postedon2022-10-1813:30:17|under模板|sourceconstchar*name="bit";#include<cstdio>#include<cstring>#include<algorithm>usingnamespacestd;type......
  • 【模板】动态树 Link-Cut Tree
    postedon2022-08-1718:05:59|under模板|sourcetemplate<intN>structlctree{ intval[N+10],sum[N+10],fa[N+10],ch[N+10][2],rev[N+10]; boolgetson(intp)......
  • 【模板】点分治 Centroid Decomposition
    postedon2022-07-2018:59:16|under模板|source0x00模板（P3806）给定\(n,k\)和一棵树，计算\[\sum\limits_{i,j\leqn}[{\ttdist}(i,j)=k]\]即树上距离为\(k\)......
  • 【模板】并查集 DSU
    postedon2021-09-1215:49:52|under模板|source0x00模板并查集维护的是这样一个问题：\(n\)个点，初始时每个点自己一个集合。\({\ttmerge}(x,y)\)：合并\(x,y\)......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99