【控件功能】我来做练习-第51课-Unidac连接池

Unidac连接池

提示：UntCobblerUniPool.pas
unit UntCobblerUniPool;

interface

uses
classes, SysUtils, DateUtils, UntThreadTimer,
Uni, DBAccess;
//unidac必须的单元
//UniProvider, SQLServerUniProvider
//ODBCUniProvider,AccessUniProvider;
//数据库配置记录
//驱动;登陆用户;密码;服务器;数据库;端口;
type
TSrvDBConnection = class
Provider :string;//数据库驱动
UserName :string;//SQL用户
Password :string;//登陆用户
Server :string;//DB服务器
DataBase :string;//DB名字
port :Integer;//端口
//SpecificOptions:TStrings;//详细配置
end;

type
TUniCobbler = class
private
FFlag: boolean; //当前对象是否被使用
FConnObj: TUniConnection; //数据库连接对象
FConnStr: String;//连接字符串
FAStart: TDateTime;//最后一次活动时间
FSrvDBConfig : TSrvDBConnection;//数据库配置记录
public
constructor Create(tmpConnStr:string);overload;
destructor Destroy;override;

property Flag:boolean  read FFlag write FFlag;
property ConnObj: TUniConnection read FConnObj;
property ConnStr: String read FConnStr write FConnStr;
property AStart: TDateTime read FAStart write FAStart;

end;

type
TUniCobblerPool = class
procedure OnMyTimer(Sender: TObject);//做轮询用
private
FPOOLNUMBER:Integer; //池大小
FMPollingInterval:Integer;//轮询时间 以 分钟 为单位
FList:TThreadList;//用来管理连接TADOCobbler
FTime :TThreadedTimer;//主要做轮询
FSXunHuan:Integer;//间隔多少秒 轮询一次 Flist

function GetListCount:Integer; //返回池中 连接数
procedure SetPoolCount(Value:Integer);//动态设置池大小
function GetItems(Index: integer):TUniCobbler; //返回指定 TUniCobbler
procedure SetFSXunHuan(Value:Integer);

function CreateUniCobbler(const tmpConnStr:string):TUniCobbler;

public
constructor Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);overload;
destructor Destroy;override;
function GetUniCon(const tmpConnStr:string):TUniCobbler;//从池中取出可用的连接
procedure FreeBackPool(Instance: TUniCobbler);//释放回归到池中

procedure FreeUniCon; //回收池中许久未用的连接
property Count:Integer read GetListCount;//返回已用池大小
property  PoolCount:Integer read FPOOLNUMBER write SetPoolCount; //池容量属性
property  Items[Index: integer]:TUniCobbler read GetItems;
property Interval:Integer  read FSXunHuan write SetFSXunHuan;

end;

procedure SetSrvDBConfig(Connstr:string;SrvDBConfig:TSrvDBConnection);//配置数据库配置文件

implementation

procedure SetSrvDBConfig(Connstr:string;SrvDBConfig:TSrvDBConnection);
var
tmpConstr,tmpStr:string;
i:Integer;
begin
if not Assigned(SrvDBConfig) then Exit;
//驱动;登陆用户;密码;服务器;数据库;端口
tmpConstr := Connstr;
if tmpConstr[Length(tmpConstr)] <> ‘;’ then tmpConstr := tmpConstr + ‘;’;
//自己定义的
//取6次 1 驱动 2用户 3密码 4服务器 5数据库 6端口
i:=Pos(‘;’,tm