//==============================================================================
// TADOConnection池 咏南工作室(陈新光) 2008-10-06 14:00:23
//==============================================================================
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.