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.