当连接数多，使用频繁时，用连接池大大提高效率

unit uDBPool;

interface

uses Classes ,ADODB,ADOInt,Messages,SysUtils,DataDefine,Windows , Forms,

Dialogs;

type

TDBPool = class

private

FList :TList;

FbLoad :Boolean;

FsConnStr :String;

FbResetConnect: Boolean;  //是否准备复位所有的连接

CS_GetConn: TRTLCriticalSection;

FConnStatus: Boolean;// ADOConnection 连接状态

procedure Clear;

procedure Load;

protected

procedure ConRollbackTransComplete(

Connection: TADOConnection; const Error: ADOInt.Error;

var EventStatus: TEventStatus);

procedure ConCommitTransComplete(

Connection: TADOConnection; const Error: ADOInt.Error;

var EventStatus: TEventStatus);

procedure ConBeginTransComplete(

Connection: TADOConnection; TransactionLevel: Integer;

const Error: ADOInt.Error; var EventStatus: TEventStatus);

public

constructor Create(ConnStr :string);

destructor Destroy; override;

procedure Reset;

function GetConnection: PRecConnection;

procedure AddConnetion ;  // GetConnection繁忙遍历多次时，添加新连接

procedure FreeIdleConnetion ; // 销毁闲着的链接

procedure RemoveConnection(ARecConnetion: PRecConnection);

procedure CloseConnection;   //关闭所有连接

property bConnStauts : Boolean read FConnStatus write FConnStatus default True;

end;

var

DataBasePool : TDBPool;

implementation

{ TDBPool }

procedure TDBPool.ConRollbackTransComplete(

Connection: TADOConnection; const Error: ADOInt.Error;

var EventStatus: TEventStatus);

begin

Now_SWcount := Now_SWcount-1;

end;

procedure TDBPool.ConCommitTransComplete(

Connection: TADOConnection; const Error: ADOInt.Error;

var EventStatus: TEventStatus);

begin

Now_SWcount := Now_SWcount-1;

end;

procedure TDBPool.ConBeginTransComplete(

Connection: TADOConnection; TransactionLevel: Integer;

const Error: ADOInt.Error; var EventStatus: TEventStatus);

begin

Now_SWcount := Now_SWcount+1;

end;

constructor TDBPool.Create(ConnStr: string);

begin

inherited Create;

InitializeCriticalSection(CS_GetConn); //初始临界区对象。

FbResetConnect := False;

FList  := TList.Create;

FbLoad := False;

FsConnStr := ConnStr;

Load;

end;

destructor TDBPool.Destroy;

begin

Clear;

FList.Free;

DeleteCriticalSection(CS_GetConn);

inherited;

end;

procedure TDBPool.Clear;

var

i:Integer;

tmpRecConn :PRecConnection;

begin

for i:= 0 to FList.Count-1 do

begin

tmpRecConn := FList.items[i];

tmpRecConn^.ADOConnection.Close;

tmpRecConn^.ADOConnection.Free;

Dispose(tmpRecConn);

FList.Items[i] := nil;

end;

FList.Pack;

FList.Clear;

end;

procedure TDBPool.Load;

var

i :Integer;

tmpRecConn :PRecConnection;

AdoConn :TADOConnection;

begin

if FbLoad then Exit;

Clear;

for i:=1 to iConnCount do

begin

AdoConn := TADOConnection.Create(nil);

AdoConn.ConnectionString:= FsConnStr;

AdoConn.OnRollbackTransComplete := ConRollbackTransComplete;

AdoConn.OnCommitTransComplete   := ConCommitTransComplete;

AdoConn.OnBeginTransComplete    := ConBeginTransComplete;

//    AdoConn.Open;

AdoConn.LoginPrompt := False;

New(tmpRecConn);

tmpRecConn^.ADOConnection := AdoConn;

tmpRecConn^.isBusy := False;

FList.Add(tmpRecConn);

FConnStatus := True;

end;

end;

procedure TDBPool.Reset;

begin

FbLoad := False;

Load;

end;

function TDBPool.GetConnection: PRecConnection;

var

i :Integer;

tmpRecConnection :PRecConnection;

bFind :Boolean ;

begin

Result := nil;

//                   1、加互斥对象，防止多客户端同时访问

//                   2、改为循环获取连接，知道获取到为止

//                   3、加判断ADOConnection 没链接是才打开

EnterCriticalSection(CS_GetConn);

bFind :=False ;

try

try

//iFindFount :=0 ;

while (not bFind) and (not FbResetConnect) do

begin

//        if not FConnStatus then     //当测试断线的时候可能ADOConnection的状态不一定为False

//          Reset;

for i:= 0 to FList.Count-1 do

begin

//PRecConnection(FList.Items[i])^.ADOConnection.Close ;

tmpRecConnection := FList.Items[i];

if not tmpRecConnection^.isBusy then

begin

if not tmpRecConnection^.ADOConnection.Connected then

tmpRecConnection^.ADOConnection.Open;

tmpRecConnection^.isBusy := True;

Result := tmpRecConnection;

bFind :=True ;

Break;

end;

end;

application.ProcessMessages;

Sleep(50) ;

{ Inc(iFindFount) ;

if(iFindFount>=1) then

begin       // 遍历5次还找不到空闲连接，则添加链接

AddConnetion ;

end;  }

end ;

except

on e: Exception do

raise Exception.Create('TDBPOOL.GetConnection-->' + e.Message);

end;

finally

LeaveCriticalSection(CS_GetConn);

end ;

end;

procedure TDBPool.RemoveConnection(ARecConnetion: PRecConnection);

begin

if ARecConnetion^.ADOConnection.InTransaction then

ARecConnetion^.ADOConnection.CommitTrans;

ARecConnetion^.isBusy := False;

end;

procedure TDBPool.AddConnetion;

var

i,uAddCount :Integer ;

tmpRecConn :PRecConnection;

AdoConn : TADOConnection ;

begin

if  FList.Count >= iMaxConnCount  then

Exit ;

if iMaxConnCount - FList.Count > 10 then

begin

uAddCount :=10 ;

end else

begin

uAddCount :=iMaxConnCount - FList.Count ;

end;

for i:=1 to uAddCount do

begin

AdoConn := TADOConnection.Create(nil);

AdoConn.ConnectionString:= FsConnStr;

AdoConn.OnRollbackTransComplete := ConRollbackTransComplete;

AdoConn.OnCommitTransComplete   := ConCommitTransComplete;

AdoConn.OnBeginTransComplete    := ConBeginTransComplete;

//    AdoConn.Open;

AdoConn.LoginPrompt := False;

New(tmpRecConn);

tmpRecConn^.ADOConnection := AdoConn;

tmpRecConn^.isBusy := False;

FList.Add(tmpRecConn);

Dispose(tmpRecConn) ;

end;

end;

procedure TDBPool.FreeIdleConnetion;

var

i,uFreeCount,uMaxFreeCount :Integer ;

tmpRecConn : PRecConnection ;

begin

if FList.Count<=iConnCount then

Exit ;

uMaxFreeCount :=FList.Count- iConnCount ;

uFreeCount :=0 ;

for i:= 0 to FList.Count do

begin

if (uFreeCount>=uMaxFreeCount) then

Break ;

// New(tmpRecConn) ;

tmpRecConn := FList.items[i];

if tmpRecConn^.isBusy =False  then

begin

tmpRecConn^.ADOConnection.Close;

tmpRecConn^.ADOConnection.Free;

uFreeCount :=uFreeCount +1 ;

end;

Dispose(tmpRecConn);

FList.Items[i] := nil;

end;

FList.Pack;

end;

procedure TDBPool.CloseConnection;

begin

FbResetConnect := True;

EnterCriticalSection(CS_GetConn);

try

Reset;

finally

LeaveCriticalSection(CS_GetConn);

FbResetConnect := False;

end;

end;

end.