天天看点

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.