TADOConnection池

//==============================================================================
// 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.