AdoConnection连接池的使用

(*******************************************************************************
ADOConnection连接池

池满的情况下 池子ADO连接 动态创建

系统默认池子中 一个小时以上未用的 ADOConnection 连接 系统自动释放

使用如下
先Uses SQLADOPoolUnit 单元

在程序初始化时(initialization)创建连接池类
ADOConfig := TADOConfig.Create('SERVERDB.LXH');
ADOXPool := TADOPool.Create(15);

在程序关闭时(finalization)释放连接池类
ADOPool.Free;
ADOConfig.Free;

调用如下
try
ADOQuery.Connecttion:= ADOPool.GetCon(ADOConfig);
ADOQueryt.Open;
finally
ADOPool.PutCon(ADOQuery.Connecttion);
end;

作者:何应祖(QQ:306446305)
2012-10
如有优化 请传作者一份 。谢谢！

********************************************************************************)

unit SQLADOPoolUnit;

interface

uses
Winapi.Windows,Data.SqlExpr,System.SysUtils, System.Classes,Vcl.ExtCtrls, System.DateUtils,Data.DB, Data.Win.ADODB,System.IniFiles,
Winapi.Messages, Datasnap.Provider, Data.DBXMSSQL;

type// 数据库类型
TDBType=(Access,SqlServer,Oracle);

//数据库配置   ADO
type
TADOConfig = class
//数据库配置
ConnectionName :string;//连接驱动名字
ProviderName :string;//通用驱动
DBServer:string;  //数据源 --数据库服务器IP
DataBase :string; //数据库名字  //sql server连接时需要数据库名参数--数据库实例名称
OSAuthentication:Boolean;  //是否是windows验证
UserName :string; //数据库用户
PassWord :string; //密码
AccessPassWord:string;  //Access可能需要数据库密码
Port:integer;//数据库端口
//
DriverName :string;//驱动
HostName :string;//服务地址
//端口配置
TCPPort:Integer; //TCP端口
HttpPort:Integer; //http 端口
LoginSrvUser:string;//验证中间层服务登录用户
LoginSrvPassword:string;//验证登录模块密码
public
constructor Create(iniFile :String);overload;
destructor Destroy; override;
end;

type
TADOCon = class
private
FConnObj:TADOConnection;  //数据库连接对象
FAStart: TDateTime;        //最后一次活动时间

function GetUseFlag: Boolean;
procedure SetUseFlag(value: Boolean);
public
constructor Create(ADOConfig :TADOConfig);overload;
destructor Destroy;override;
//当前对象是否被使用
property UseFlag :boolean read GetUseFlag write SetUseFlag ;
property ConnObj :TADOConnection read FConnObj;
property AStart :TDateTime read FAStart write FAStart;
end;

type
TADOPool = class
procedure OnMyTimer(Sender: TObject);//做轮询用
private
FSection :TRTLCriticalSection;
FPoolNumber :Integer;     //池大小
FPollingInterval :Integer;//轮询时间 以 分 为单位
FADOCon :TADOCon;
FList :TList;             //用来管理连接TADOCobbler
FTime :TTimer;            //主要做轮询
procedure Enter;
procedure Leave;
function SameConfig(const Source:TADOConfig; Target:TADOCon):Boolean;
function GetConnectionCount: Integer;
public
constructor Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);overload;
destructor Destroy;override;
//从池中取出可用的连接。
function GetCon(const tmpConfig :TADOConfig):TADOConnection;
//把用完的连接放回连接池。
procedure PutCon(const ADOConnection :TADOConnection);
//释放池中许久未用的连接，由定时器定期扫描执行
procedure FreeConnection;
//当前池中连接数.
property ConnectionCount: Integer read GetConnectionCount;
end;

var
ADOPool: TADOPool;
ADOConfig: TADOConfig;
implementation

{ TADOConfig }
constructor TADOConfig.Create(iniFile :String);
var
DBIniFile: TIniFile;
begin
try
DBIniFile := TIniFile.Create(iniFile);
ConnectionName := DBIniFile.ReadString('Connection','ConnectionName', 'SQLConnection');
DriverName := DBIniFile.ReadString('Connection','DriverName', 'MSDASQL');
ProviderName := DBIniFile.ReadString('Connection','ProviderName', 'MSDASQL');
DBServer:= DBIniFile.ReadString('Connection','DBServer', '127.0.0.1');
HostName := DBIniFile.ReadString('Connection','HostName', '127.0.0.1');
DataBase := DBIniFile.ReadString('Connection','DataBase', 'GPMS2000');
Port:=DBIniFile.ReadInteger('Connection','Port', 1433);
UserName := DBIniFile.ReadString('Connection','UserName', 'Sa');
PassWord := DBIniFile.ReadString('Connection','PassWord', 'Sa');
LoginSrvUser := DBIniFile.ReadString('Connection','LoginSrvUser', 'hyz');
LoginSrvPassword := DBIniFile.ReadString('Connection','LoginSrvPassword', 'hyz');
TCPPort := DBIniFile.ReadInteger('Connection','TCPPort', 211);
HttpPort := DBIniFile.ReadInteger('Connection','HttpPort', 2110);
OSAuthentication := DBIniFile.ReadBool('Connection','OSAuthentication', False);

if Not FileExists(iniFile) then
begin
If Not DirectoryExists(ExtractFilePath(iniFile)) Then ForceDirectories(ExtractFilePath(iniFile));
DBIniFile.WriteString('Connection','ConnectionName', ConnectionName);
DBIniFile.WriteString('Connection','DriverName', DriverName);
DBIniFile.WriteString('Connection','HostName', HostName);
DBIniFile.WriteString('Connection','DBServer', HostName);
DBIniFile.WriteString('Connection','DataBase', DataBase);
//     DBIniFile.WriteString('Connection','Port',Port);
DBIniFile.WriteString('Connection','UserName', UserName);
DBIniFile.WriteString('Connection','PassWord', PassWord);
DBIniFile.WriteString('Connection','LoginSrvUser', LoginSrvUser);
DBIniFile.WriteString('Connection','LoginSrvPassword', LoginSrvPassword);
DBIniFile.WriteInteger('Connection','TCPPort', TCPPort);
DBIniFile.WriteInteger('Connection','HttpPort', HttpPort);
DBIniFile.WriteBool('Connection','OSAuthentication', OSAuthentication);
end;
finally
FreeAndNil(DBIniFile);
end;
end;

destructor TADOConfig.Destroy;
begin
inherited;
end;

{ TADOCon }
constructor TADOCon.Create(ADOConfig: TADOConfig);
//var
//  str:string;
begin
//  str:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID='+ADOConfig.UserName+';password='+ADOConfig.PassWord+';Initial Catalog='+ADOConfig.DataBase+';Data Source='+ADOConfig.DBServer;
FConnObj:=TADOConnection.Create(nil);
with FConnObj do
begin
LoginPrompt:=False;
Tag:=GetTickCount;
ConnectionTimeout:=18000;
Provider:=ADOConfig.ProviderName;
Properties['Data Source'].Value:=ADOConfig.DBServer;
Properties['User ID'].Value:=ADOConfig.UserName;
Properties['Password'].Value:=ADOConfig.PassWord;
Properties['Initial Catalog'].Value:=ADOConfig.DataBase;

//    ConnectionString:=str;
try
Connected:=True;
except
raise Exception.Create('数据库连接失败');
end;
end;
end;

destructor TADOCon.Destroy;
begin
FAStart := 0;
if Assigned(FConnObj) then
BEGIN
if FConnObj.Connected then FConnObj.Close;
FreeAndnil(FConnObj);
END;
inherited;
end;

procedure TADOCon.SetUseFlag(value :Boolean);
begin
//False表示闲置，True表示在使用。
if not value then
FConnObj.Tag := 0
else
begin
if FConnObj.Tag = 0 then FConnObj.Tag := 1;  //设置为使用标识。
FAStart := now;                              //设置启用时间 。
end;
end;

Function TADOCon.GetUseFlag :Boolean;
begin
Result := (FConnObj.Tag>0);  //Tag=0表示闲置，Tag>0表示在使用。
end;

{ TADOPool }
constructor TADOPool.Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);
begin
InitializeCriticalSection(FSection);
FPOOLNUMBER := MaxNumBer; //设置池大小
FPollingInterval := FreeMinutes;// 连接池中  FPollingInterval 以上没用的 自动回收连接池
FList := TList.Create;
FTime := TTimer.Create(nil);
FTime.Enabled := False;
FTime.Interval := TimerTime;//5秒检查一次
FTime.OnTimer := OnMyTimer;
FTime.Enabled := True;
end;

destructor TADOPool.Destroy;
var
i:integer;
begin
FTime.OnTimer := nil;
FTime.Free;
for i := FList.Count - 1 downto 0  do
begin
try
FADOCon := TADOCon(FList.Items[i]);
if Assigned(FADOCon) then
FreeAndNil(FADOCon);
FList.Delete(i);
except
end;
end;
FList.Free;
DeleteCriticalSection(FSection);
inherited;
end;

procedure TADOPool.Enter;
begin
EnterCriticalSection(FSection);
end;

procedure TADOPool.Leave;
begin
LeaveCriticalSection(FSection);
end;

//根据字符串连接参数 取出当前连接池可以用的TADOConnection
function TADOPool.GetCon(const tmpConfig :TADOConfig):TADOConnection;
var
i:Integer;
IsResult :Boolean; //标识
CurOutTime:Integer;
begin
Result := nil;
IsResult := False;
CurOutTime := 0;
Enter;
try
for I := 0 to FList.Count - 1 do
begin
FADOCon := TADOCon(FList.Items[i]);
if not FADOCon.UseFlag then //可用
if SameConfig(tmpConfig,FADOCon) then  //找到
begin
FADOCon.UseFlag := True; //标记已经分配用了
Result :=  FADOCon.ConnObj;
IsResult := True;
Break;//退出循环
end;
end; // end for
finally
Leave;
end;
if IsResult then Exit;
//池未满 新建一个
Enter;
try
if FList.Count < FPOOLNUMBER then //池未满
begin
FADOCon := TADOCon.Create(tmpConfig);
FADOCon.UseFlag := True;
Result :=  FADOCon.ConnObj;
IsResult := True;
FList.Add(FADOCon);//加入管理队列
end;
finally
Leave;
end;
if IsResult then Exit;
//池满 等待 等候释放
while True do
begin
Enter;
try
for I := 0 to FList.Count - 1 do
begin
FADOCon := TADOCon(FList.Items[i]);
if SameConfig(tmpConfig,FADOCon) then  //找到
if not FADOCon.UseFlag then //可用
begin
FADOCon.UseFlag := True; //标记已经分配用了
Result :=  FADOCon.ConnObj;
IsResult := True;
Break;//退出循环
end;
end; // end for
if IsResult then Break; //找到退出
finally
Leave;
end;
//如果不存在这种字符串的池子 则 一直等到超时
if CurOutTime >= 5000 * 6 then  //1分钟
begin
raise Exception.Create('连接超时!');
Break;
end;
Sleep(500);//0.5秒钟
CurOutTime := CurOutTime + 500; //超时设置成60秒
end;//end while
end;

procedure TADOPool.PutCon(const ADOConnection :TADOConnection);
var i :Integer;
begin
{
if not Assigned(ADOConnection) then Exit;
try
Enter;
ADOConnection.Tag := 0;  //如此应该也可以 ，未测试...
finally
Leave;
end;
}
Enter;  //并发控制
try
for I := FList.Count - 1 downto 0 do
begin
FADOCon := TADOCon(FList.Items[i]);
if FADOCon.ConnObj=ADOConnection then
begin
FADOCon.UseFlag := False;
Break;
end;
end;
finally
Leave;
end;
end;

procedure TADOPool.FreeConnection;
var
i:Integer;
function MyMinutesBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Round(MinuteSpan(ANow, AThen));
end;
begin
Enter;
try
for I := FList.Count - 1 downto 0 do
begin
FADOCon := TADOCon(FList.Items[i]);
if MyMinutesBetween(Now,FADOCon.AStart) >= FPollingInterval then //释放池子许久不用的ADO
begin
FreeAndNil(FADOCon);
FList.Delete(I);
end;
end;
finally
Leave;
end;
end;

procedure TADOPool.OnMyTimer(Sender: TObject);
begin
FreeConnection;
end;

function TADOPool.SameConfig(const Source:TADOConfig;Target:TADOCon): Boolean;
begin
//考虑到支持多数据库连接，需要本方法做如下等效连接判断.如果是单一数据库，可忽略本过程。
{  Result := False;
if not Assigned(Source) then Exit;
if not Assigned(Target) then Exit;

Result := SameStr(LowerCase(Source.ConnectionName),LowerCase(Target.ConnObj.Name));
Result := Result and SameStr(LowerCase(Source.DriverName),LowerCase(Target.ConnObj.Provider));
Result := Result and SameStr(LowerCase(Source.HostName),LowerCase(Target.ConnObj.Properties['Data Source'].Value));
Result := Result and SameStr(LowerCase(Source.DataBase),LowerCase(Target.ConnObj.Properties['Initial Catalog'].Value));
Result := Result and SameStr(LowerCase(Source.UserName),LowerCase(Target.ConnObj.Properties['User ID'].Value));
Result := Result and SameStr(LowerCase(Source.PassWord),LowerCase(Target.ConnObj.Properties['Password'].Value));
//Result := Result and (Source.OSAuthentication = Target.ConnObj.OSAuthentication);
}
end;

Function TADOPool.GetConnectionCount :Integer;
begin
Result := FList.Count;
end;
//初始化时创建对象
initialization
//ini文件后缀更名为LXH，方便远程安全下载更新
ADOConfig := TADOConfig.Create(ExtractFilePath(ParamStr(0))+'SERVERDB.LXH');
ADOPool := TADOPool.Create(15);
finalization
if Assigned(ADOPool) then ADOPool.Free;
if Assigned(ADOConfig) then ADOConfig.Free;

end.