当连接数多,使用频繁时,用连接池大大提高效率
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.