咏南的连接池

unit UDataConnPool;

interface

uses
SysUtils, Classes, DB, ADODB, Contnrs, Windows, ExtCtrls;

const//ole db provider
c_sql='sqloledb';
c_access='microsoft.jet.oledb.4.0';
c_oracle='MSDAORA.1';

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

type//连接池参数
RConnParameter=record
ConnMin:Integer; //池中对象的最小数
ConnMax:Integer; //池中对象的最大数
TimeOut:Integer; //空闲连接超时 600000(10分钟)
TimeOut2:Integer; //占用连接超时 3600000(1小时)
RefreshTime:Integer; //秒,轮询池的时间间隔
dbSource:string; //数据源
DB:string; //sql server连接时需要数据库名参数
dbUser:string; //登录数据库的用户名
dbPass:string; //用户密码
dbpass2:string; //Access可能需要数据库密码
end;

type
TDataConnectionPool = class(TComponent) //数据库连接池类
private
fConnParameter : RConnParameter;
fConnList : TComponentList;
fCleanTimer : TTimer;
fDBType: TDBType;
procedure fCleanOnTime(sender : TObject);
function fCreateADOConn : TADOConnection; //创建新的空闲连接
procedure fClean; //清理 （清理长时间不用的和长时间不归还的（死的）连接）
{ Private declarations }
protected
function getConnCount: Integer;
public
{ Public declarations }
property ConnCount: Integer read getConnCount;
constructor Create(owner : TComponent; connParam: RConnParameter;dbType:TDBType);overload;
function getConn : TADOConnection; //取得空闲连接
procedure returnConn(conn : TADOConnection); //归还连接
end;

implementation

//connParam(连接池参数) dbType(数据库类型)
constructor TDataConnectionPool.Create(owner : TComponent; connParam: RConnParameter;dbType:TDBType);
var
index: Integer;
begin
inherited Create(owner);
fDBType:=dbType;

fConnParameter.ConnMin := connParam.ConnMin;
fConnParameter.ConnMax := connParam.ConnMax;
fConnParameter.TimeOut:=connParam.TimeOut;
fConnParameter.TimeOut2:=connParam.TimeOut2;
fConnParameter.RefreshTime := connParam.RefreshTime;
fConnParameter.dbUser := connParam.dbUser;
fConnParameter.dbPass := connParam.dbPass;
fConnParameter.dbpass2:=connParam.dbpass2;
fConnParameter.dbSource := connParam.dbSource;
fConnParameter.DB:=connParam.DB;

if fConnList = nil then
begin
fConnList := TComponentList.Create; //池容器 TComponentList
for index := 1 to fConnParameter.ConnMin do //创最小连接个数个建数据库连接
fConnList.Add(fCreateADOConn);
end;

if fCleanTimer = nil then //清理程序启动的时间间隔
begin
fCleanTimer := TTimer.Create(Self);
fCleanTimer.Name := 'MyCleanTimer1';
fCleanTimer.Interval := fConnParameter.RefreshTime * 1000;
fCleanTimer.OnTimer := fCleanOnTime;
fCleanTimer.Enabled := True;
end;
end;

procedure TDataConnectionPool.fClean;
var
iNow : Integer;
iCount : Integer;
index : Integer;
begin
iNow := GetTickCount;
iCount := fConnList.Count;
for index := iCount - 1 downto 0 do
begin
if TADOConnection(fConnList[index]).Tag > 0 then //空闲连接
begin
if fConnList.Count > fConnParameter.ConnMin then
begin //空闲时间=当前时间-最后活动时间
if iNow - TADOConnection(fConnList[index]).Tag > fConnParameter.TimeOut then//超过10分钟不使用的、大于连接池最小数目的空闲连接将被释放
fConnList.Delete(index);
end;
end
else if TADOConnection(fConnList[index]).Tag < 0 then //占用连接
begin
if iNow + TADOConnection(fConnList[index]).Tag > fConnParameter.TimeOut2 then //被连续使用超过1小时的连接（很可能是死连接将被）释放
begin
fConnList.Delete(index);
if fConnList.Count < fConnParameter.ConnMin then //若小于连接池最小数目，则创建新的空闲连接
fConnList.Add(fCreateADOConn);
end;
end
end;
end;

procedure TDataConnectionPool.fCleanOnTime(sender: TObject);
begin
fClean;
end;

function TDataConnectionPool.fCreateADOConn: TADOConnection;
var
conn:TADOConnection;
begin
Conn:=TADOConnection.Create(Self);
with conn do
begin
LoginPrompt:=False;
Tag:=GetTickCount;

case fDBType of
sqlserver:
begin
Provider:=c_sql;
Properties['Data Source'].Value:=fConnParameter.dbSource;
Properties['User ID'].Value:=fConnParameter.dbUser;
Properties['Password'].Value:=fConnParameter.dbPass;
Properties['Initial Catalog'].Value:=fConnParameter.DB;
end;

access:
begin
Provider:=c_access;
Properties['Jet OLEDB:Database Password'].Value:=fConnParameter.dbPass2;
Properties['Data Source'].Value:=fConnParameter.dbSource;
Properties['User ID'].Value:=fConnParameter.dbUser;
Properties['Password'].Value:=fConnParameter.dbPass;
end;

oracle:
begin
Provider:=c_oracle;
Properties['Data Source'].Value:=fConnParameter.dbSource;
Properties['User ID'].Value:=fConnParameter.dbUser;
Properties['Password'].Value:=fConnParameter.dbPass;
end;
end;

try
Connected:=True;
Result:=conn;
except
Result:=nil;
raise Exception.Create('数据库连接失败');
end;
end;
end;

function TDataConnectionPool.getConn: TADOConnection;
var
index : Integer;
begin
Result := nil;
for index := 0 to fConnList.Count - 1 do
begin
if TADOConnection(fConnList[index]).Tag > 0 then
begin
Result := TADOConnection(fConnList[index]);
Result.Tag := - GetTickCount; //使用开始计时 （负数表示正在使用
end;
end;

if (Result = nil) and (index < fConnParameter.ConnMax) then//无空闲连接，而连接池数目小于允许最大数目（fMax），创建新的连接
begin
Result := fCreateADOConn;
Result.Tag := - GetTickCount; //使用,开始计时 （负数表示正在使用）
fConnList.Add(Result);
end;
end;

function TDataConnectionPool.getConnCount: Integer;
begin
Result := fConnList.Count;
end;

procedure TDataConnectionPool.returnConn(conn: TADOConnection);
begin
if fConnList.IndexOf(conn) > -1 then
conn.Tag := GetTickCount;
end;

end.

//==============================================================================
// TADOQuery池 咏南工作室 2008-10-06 14:22:35
//==============================================================================

unit UAdoQueryPool;

interface

uses
SysUtils, Classes, DB, ADODB, Contnrs, Windows, ExtCtrls;

type
RQueryParams=record
QueryMin:Integer; //池中对象最小数 10
QueryMax:Integer; //池中对象最大数 100
TimerTime:Integer; //清理程序启动的时间间隔 600000(10分钟)
end;

type
TAdoQueryPool = class(TComponent) //AdoQuery缓冲池类
private
fAdoQueryMin : Integer;
fAdoQueryMax : Integer;
fAdoQueryList : TComponentList;
fCleanTimer : TTimer;
fQueryParams:RQueryParams;
procedure fCleanOnTime(sender : TObject); //按时整理缓冲池
function fCreateADOQuery : TADOQuery; //创建新的AdoQuery
procedure fClean; //整理 （清理长时间不用的和长时间不归还的AdoQuery）
{ Private declarations }
public
{ Public declarations }
constructor Create(owner : TComponent;QueryParams:RQueryParams);
function getAdoQuery : TADOQuery; //取得空闲TADOQuery
procedure returnAdoQuery(qry : TADOQuery); //归还
end;


implementation

{ TAdoQueryPool }

constructor TAdoQueryPool.Create(owner: TComponent;QueryParams:RQueryParams);
var
index : Integer;
aAdoQuery : TADOQuery;
begin
fQueryParams:=QueryParams;

fAdoQueryMin := fQueryParams.QueryMin;
fAdoQueryMax := fQueryParams.QueryMax;
fAdoQueryList := TComponentList.Create(False);
for index := 1 to fAdoQueryMin do
fAdoQueryList.Add(fCreateADOQuery);

if fCleanTimer = nil then
begin
fCleanTimer := TTimer.Create(Self);
fCleanTimer.Name := 'MyCleanTimer1';
fCleanTimer.Interval :=fQueryParams.TimerTime; //清理程序启动的时间间隔(10分钟)
fCleanTimer.OnTimer := fCleanOnTime;
fCleanTimer.Enabled := True;
end;
end;

procedure TAdoQueryPool.fClean;
var
iNow : Integer; //当前时刻
iCount : Integer; //List大小
index : Integer;
begin
iNow := GetTickCount;
iCount := fAdoQueryList.Count;
for index := iCount - 1 downto 0 do
begin
if TADOQuery(fAdoQueryList[index]).Tag > 0 then //若空闲
begin
if fAdoQueryList.Count > fAdoQueryMin then //若AdoQuery个数大于最小值
begin
TADOQuery(fAdoQueryList[index]).Free;
end
else if TAdoQuery(fAdoQueryList[index]).Tag < 0 then
begin
if iNow + TADOQuery(fAdoQueryList[index]).Tag > 10800000 then //被连续使用超过3小时的AdoQuery（很可能是死的），释放
begin
TADOQuery(fAdoQueryList[index]).Free;
if fAdoQueryList.Count < fAdoQueryMin then//若小于缓冲池最小数目，则创建新的空闲AdoQuery
fAdoQueryList.Add(fCreateADOQuery);
end;
end;
end;
end;
end;

procedure TAdoQueryPool.fCleanOnTime(sender: TObject);
begin
fClean;
end;

function TAdoQueryPool.fCreateADOQuery: TADOQuery;
begin
Result := TADOQuery.Create(Self);
Result.Tag := GetTickCount; //空闲，开始计时(正数表示空闲)
end;

function TAdoQueryPool.getAdoQuery: TADOQuery;
var
index : Integer;
begin
Result := nil;
for index := 0 to fAdoQueryList.Count - 1 do
begin
if TADOQuery(fAdoQueryList[index]).Tag > 0 then
begin
Result := TADOQuery(fAdoQueryList[index]);
Result.Tag := - GetTickCount; //使用开始计时 （负数表示正在使用）
end;
end;

if (Result = nil) and (index < fAdoQueryMax) then//无空闲AdoQuery，而缓冲池数目小于允许最大数目（fAdoQueryMax），创建新的Adoquery
begin
Result := fCreateADOQuery;
Result.Tag := - GetTickCount; //使用,开始计时 （负数表示正在使用）
fAdoQueryList.Add(Result);
end;
end;

procedure TAdoQueryPool.returnAdoQuery(qry: TADOQuery);
begin
if fAdoQueryList.IndexOf(qry) > -1 then
qry.Tag := GetTickCount; //开始空闲计时
end;

end.