天天看點

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.