ADOConnection数据库连接池
2016-04-17 07:44
567 查看
[delphi] view plain copy
print?
unit AdoconnectPool;
interface
uses
Classes, Windows, SysUtils, ADODB, IniFiles, forms;
type
TADOConnectionPool = class(TObject)
private
FObjList:TThreadList;
FTimeout: Integer;
FMaxCount: Integer;
FSemaphore: Cardinal;
function CreateNewInstance(List:TList): TADOConnection;
function GetLock(List:TList;Index: Integer): Boolean;
public
property Timeout:Integer read FTimeout write FTimeout;
property MaxCount:Integer read FMaxCount;
constructor Create(ACapicity:Integer=30);overload;
destructor Destroy;override;
function Lock: TADOConnection;
procedure Unlock(var Value: TADOConnection);
end;
var
ConnPool: TADOConnectionPool;
g_ini: TIniFile;
implementation
constructor TADOConnectionPool.Create(ACapicity:Integer=30);
begin
FObjList:=TThreadList.Create;
FTimeout := 3000; // 3 second
FMaxCount := ACapicity;
FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);
end;
function TADOConnectionPool.CreateNewInstance(List:TList): TADOConnection;
var
p: TADOConnection;
function GetConnStr: string;
begin
try
Result := g_ini.ReadString('ado','connstr','');
except
Exit;
end;
end;
begin
try
p := TADOConnection.Create(nil);
p.ConnectionString := GetConnStr;
p.LoginPrompt := False;
p.Connected:=True;
p.Tag := 1;
List.Add(p);
Result := p;
except
on E: Exception do
begin
Result := nil;
Exit;
end;
end;
end;
destructor TADOConnectionPool.Destroy;
var
i: Integer;
List:TList;
begin
List:=FObjList.LockList;
try
for i := List.Count - 1 downto 0 do
begin
TADOConnection(List[i]).Free;
end;
finally
FObjList.UnlockList;
end;
FObjList.Free;
FObjList := nil;
CloseHandle(FSemaphore);
inherited;
end;
function TADOConnectionPool.GetLock(List:TList;Index: Integer): Boolean;
begin
try
Result := TADOConnection(List[Index]).Tag = 0;
if Result then
TADOConnection(List[Index]).Tag := 1;
except
Result :=False;
Exit;
end;
end;
function TADOConnectionPool.Lock: TADOConnection;
var
i: Integer;
List:TList;
begin
try
Result :=nil;
if WaitForSingleObject(FSemaphore, Timeout) = WAIT_FAILED then Exit;
List:=FObjList.LockList;
try
for i := 0 to List.Count - 1 do
begin
if GetLock(List,i) then
begin
Result := TADOConnection(List[i]);
PostMessage(Application.MainForm.Handle,8888,13,0);
Exit;
end;
end;
if List.Count < MaxCount then
begin
Result := CreateNewInstance(List);
PostMessage(Application.MainForm.Handle,8888,11,0);
end;
finally
FObjList.UnlockList;
end;
except
Result := nil;
Exit;
end;
end;
procedure TADOConnectionPool.Unlock(var Value: TADOConnection);
var
List:TList;
begin
try
List:=FObjList.LockList;
try
TADOConnection(List[List.IndexOf(Value)]).Tag :=0;
ReleaseSemaphore(FSemaphore, 1, nil);
finally
FObjList.UnlockList;
end;
PostMessage(Application.MainForm.Handle, 8888, 12, 0);
except
Exit;
end;
end;
initialization
ConnPool := TADOConnectionPool.Create();
g_ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'server.ini');
finalization
FreeAndNil(ConnPool);
FreeAndNil(g_ini);
end.
2.
[delphi] view plain copy
print?
Delphi做服务器端如果每次请求都创建一个连接就太耗资源了，而使用一个全局的连接那效率可想而知，这样就体现出了线程池的重要了。参考一些例子做了个ADO的连接池，用到项目中挺不错的，分享下。
{ ******************************************************* }
{ Description : ADO连接池 }
{ Create Date : 2010-8-31 23:22:09 }
{ Modify Remark :2010-9-1 12:00:09 }
{ Modify Date : }
{ Version : 1.0 }
{ ******************************************************* }
unit ADOConnectionPool;
interface
uses
Classes, Windows, SyncObjs, SysUtils, ADODB;
type
TADOConnectionPool = class(TObject)
private
FConnectionList:TThreadList;
//FConnList: TList;
FTimeout: Integer;
FMaxCount: Integer;
FSemaphore: Cardinal;
//FCriticalSection: TCriticalSection;
FConnectionString,
FDataBasePass,
FDataBaseUser:string;
function CreateNewInstance(AOwnerList:TList): TADOConnection;
function GetLock(AOwnerList:TList;Index: Integer): Boolean;
public
property ConnectionString:string read FConnectionString write FConnectionString;
property DataBasePass:string read FDataBasePass write FDataBasePass;
property DataBaseUser:string read FDataBaseUser write FDataBaseUser;
property Timeout:Integer read FTimeout write FTimeout;
property MaxCount:Integer read FMaxCount;
constructor Create(ACapicity:Integer=15);overload;
destructor Destroy;override;
/// <summary>
/// 申请并一个连接并上锁，使用完必须调用UnlockConnection来释放锁
/// </summary>
function LockConnection: TADOConnection;
/// <summary>
/// 释放一个连接
/// </summary>
procedure UnlockConnection(var Value: TADOConnection);
end;
type
PRemoteConnection=^TRemoteConnection;
TRemoteConnection=record
Connection : TADOConnection;
InUse:Boolean;
end;
var
ConnectionPool: TADOConnectionPool;
implementation
constructor TADOConnectionPool.Create(ACapicity:Integer=15);
begin
//FConnList := TList.Create;
FConnectionList:=TThreadList.Create;
//FCriticalSection := TCriticalSection.Create;
FTimeout := 15000;
FMaxCount := ACapicity;
FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);
end;
function TADOConnectionPool.CreateNewInstance(AOwnerList:TList): TADOConnection;
var
p: PRemoteConnection;
begin
Result := nil;
New(p);
p.Connection := TADOConnection.Create(nil);
p.Connection.ConnectionString := ConnectionString;
p.Connection.LoginPrompt := False;
try
if (DataBaseUser='') and (DataBasePass='') then
p.Connection.Connected:=True
else
p.Connection.Open(DataBaseUser, DataBasePass);
except
p.Connection.Free;
Dispose(p);
raise;
Exit;
end;
p.InUse := True;
AOwnerList.Add(p);
Result := p.Connection;
end;
destructor TADOConnectionPool.Destroy;
var
i: Integer;
ConnList:TList;
begin
//FCriticalSection.Free;
ConnList:=FConnectionList.LockList;
try
for i := ConnList.Count - 1 downto 0 do
begin
try
PRemoteConnection(ConnList[i]).Connection.Free;
Dispose(ConnList[i]);
except
//忽略释放错误
end;
end;
finally
FConnectionList.UnlockList;
end;
FConnectionList.Free;
CloseHandle(FSemaphore);
inherited Destroy;
end;
function TADOConnectionPool.GetLock(AOwnerList:TList;Index: Integer): Boolean;
begin
Result := not PRemoteConnection(AOwnerList[Index]).InUse;
if Result then
PRemoteConnection(AOwnerList[Index]).InUse := True;
end;
function TADOConnectionPool.LockConnection: TADOConnection;
var
i,WaitResult: Integer;
ConnList:TList;
begin
Result := nil;
WaitResult:= WaitForSingleObject(FSemaphore, Timeout);
if WaitResult = WAIT_FAILED then
raise Exception.Create('Server busy, please try again');
ConnList:=FConnectionList.LockList;
try
try
for i := 0 to ConnList.Count - 1 do
begin
if GetLock(ConnList,i) then
begin
Result := PRemoteConnection(ConnList[i]).Connection;
Exit;
end;
end;
if ConnList.Count < MaxCount then
Result := CreateNewInstance(ConnList);
except
// 获取信号且失败则释放一个信号量
if WaitResult=WAIT_OBJECT_0 then
ReleaseSemaphore(FSemaphore, 1, nil);
raise;
end;
finally
FConnectionList.UnlockList;
end;
if Result = nil then
begin
if WaitResult=WAIT_TIMEOUT then
raise Exception.Create('Timeout expired.Connection pool is full.')
else
{ This shouldn 't happen because of the sempahore locks }
raise Exception.Create('Unable to lock Connection');
end;
end;
procedure TADOConnectionPool.UnlockConnection(var Value: TADOConnection);
var
i: Integer;
ConnList:TList;
begin
ConnList:=FConnectionList.LockList;
try
for i := 0 to ConnList.Count - 1 do
begin
if Value = PRemoteConnection(ConnList[i]).Connection then
begin
PRemoteConnection(ConnList[I]).InUse := False;
ReleaseSemaphore(FSemaphore, 1, nil);
break;
end;
end;
finally
FConnectionList.UnlockList;
end;
end;
initialization
ConnectionPool := TADOConnectionPool.Create();
finalization
ConnectionPool.Free;
end.
3.
[delphi] view plain copy
print?
当连接数多，使用频繁时，用连接池大大提高效率
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.
http://blog.csdn.net/aroc_lo/article/details/22299303
print?
unit AdoconnectPool;
interface
uses
Classes, Windows, SysUtils, ADODB, IniFiles, forms;
type
TADOConnectionPool = class(TObject)
private
FObjList:TThreadList;
FTimeout: Integer;
FMaxCount: Integer;
FSemaphore: Cardinal;
function CreateNewInstance(List:TList): TADOConnection;
function GetLock(List:TList;Index: Integer): Boolean;
public
property Timeout:Integer read FTimeout write FTimeout;
property MaxCount:Integer read FMaxCount;
constructor Create(ACapicity:Integer=30);overload;
destructor Destroy;override;
function Lock: TADOConnection;
procedure Unlock(var Value: TADOConnection);
end;
var
ConnPool: TADOConnectionPool;
g_ini: TIniFile;
implementation
constructor TADOConnectionPool.Create(ACapicity:Integer=30);
begin
FObjList:=TThreadList.Create;
FTimeout := 3000; // 3 second
FMaxCount := ACapicity;
FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);
end;
function TADOConnectionPool.CreateNewInstance(List:TList): TADOConnection;
var
p: TADOConnection;
function GetConnStr: string;
begin
try
Result := g_ini.ReadString('ado','connstr','');
except
Exit;
end;
end;
begin
try
p := TADOConnection.Create(nil);
p.ConnectionString := GetConnStr;
p.LoginPrompt := False;
p.Connected:=True;
p.Tag := 1;
List.Add(p);
Result := p;
except
on E: Exception do
begin
Result := nil;
Exit;
end;
end;
end;
destructor TADOConnectionPool.Destroy;
var
i: Integer;
List:TList;
begin
List:=FObjList.LockList;
try
for i := List.Count - 1 downto 0 do
begin
TADOConnection(List[i]).Free;
end;
finally
FObjList.UnlockList;
end;
FObjList.Free;
FObjList := nil;
CloseHandle(FSemaphore);
inherited;
end;
function TADOConnectionPool.GetLock(List:TList;Index: Integer): Boolean;
begin
try
Result := TADOConnection(List[Index]).Tag = 0;
if Result then
TADOConnection(List[Index]).Tag := 1;
except
Result :=False;
Exit;
end;
end;
function TADOConnectionPool.Lock: TADOConnection;
var
i: Integer;
List:TList;
begin
try
Result :=nil;
if WaitForSingleObject(FSemaphore, Timeout) = WAIT_FAILED then Exit;
List:=FObjList.LockList;
try
for i := 0 to List.Count - 1 do
begin
if GetLock(List,i) then
begin
Result := TADOConnection(List[i]);
PostMessage(Application.MainForm.Handle,8888,13,0);
Exit;
end;
end;
if List.Count < MaxCount then
begin
Result := CreateNewInstance(List);
PostMessage(Application.MainForm.Handle,8888,11,0);
end;
finally
FObjList.UnlockList;
end;
except
Result := nil;
Exit;
end;
end;
procedure TADOConnectionPool.Unlock(var Value: TADOConnection);
var
List:TList;
begin
try
List:=FObjList.LockList;
try
TADOConnection(List[List.IndexOf(Value)]).Tag :=0;
ReleaseSemaphore(FSemaphore, 1, nil);
finally
FObjList.UnlockList;
end;
PostMessage(Application.MainForm.Handle, 8888, 12, 0);
except
Exit;
end;
end;
initialization
ConnPool := TADOConnectionPool.Create();
g_ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'server.ini');
finalization
FreeAndNil(ConnPool);
FreeAndNil(g_ini);
end.
2.
[delphi] view plain copy
print?
Delphi做服务器端如果每次请求都创建一个连接就太耗资源了，而使用一个全局的连接那效率可想而知，这样就体现出了线程池的重要了。参考一些例子做了个ADO的连接池，用到项目中挺不错的，分享下。
{ ******************************************************* }
{ Description : ADO连接池 }
{ Create Date : 2010-8-31 23:22:09 }
{ Modify Remark :2010-9-1 12:00:09 }
{ Modify Date : }
{ Version : 1.0 }
{ ******************************************************* }
unit ADOConnectionPool;
interface
uses
Classes, Windows, SyncObjs, SysUtils, ADODB;
type
TADOConnectionPool = class(TObject)
private
FConnectionList:TThreadList;
//FConnList: TList;
FTimeout: Integer;
FMaxCount: Integer;
FSemaphore: Cardinal;
//FCriticalSection: TCriticalSection;
FConnectionString,
FDataBasePass,
FDataBaseUser:string;
function CreateNewInstance(AOwnerList:TList): TADOConnection;
function GetLock(AOwnerList:TList;Index: Integer): Boolean;
public
property ConnectionString:string read FConnectionString write FConnectionString;
property DataBasePass:string read FDataBasePass write FDataBasePass;
property DataBaseUser:string read FDataBaseUser write FDataBaseUser;
property Timeout:Integer read FTimeout write FTimeout;
property MaxCount:Integer read FMaxCount;
constructor Create(ACapicity:Integer=15);overload;
destructor Destroy;override;
/// <summary>
/// 申请并一个连接并上锁，使用完必须调用UnlockConnection来释放锁
/// </summary>
function LockConnection: TADOConnection;
/// <summary>
/// 释放一个连接
/// </summary>
procedure UnlockConnection(var Value: TADOConnection);
end;
type
PRemoteConnection=^TRemoteConnection;
TRemoteConnection=record
Connection : TADOConnection;
InUse:Boolean;
end;
var
ConnectionPool: TADOConnectionPool;
implementation
constructor TADOConnectionPool.Create(ACapicity:Integer=15);
begin
//FConnList := TList.Create;
FConnectionList:=TThreadList.Create;
//FCriticalSection := TCriticalSection.Create;
FTimeout := 15000;
FMaxCount := ACapicity;
FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);
end;
function TADOConnectionPool.CreateNewInstance(AOwnerList:TList): TADOConnection;
var
p: PRemoteConnection;
begin
Result := nil;
New(p);
p.Connection := TADOConnection.Create(nil);
p.Connection.ConnectionString := ConnectionString;
p.Connection.LoginPrompt := False;
try
if (DataBaseUser='') and (DataBasePass='') then
p.Connection.Connected:=True
else
p.Connection.Open(DataBaseUser, DataBasePass);
except
p.Connection.Free;
Dispose(p);
raise;
Exit;
end;
p.InUse := True;
AOwnerList.Add(p);
Result := p.Connection;
end;
destructor TADOConnectionPool.Destroy;
var
i: Integer;
ConnList:TList;
begin
//FCriticalSection.Free;
ConnList:=FConnectionList.LockList;
try
for i := ConnList.Count - 1 downto 0 do
begin
try
PRemoteConnection(ConnList[i]).Connection.Free;
Dispose(ConnList[i]);
except
//忽略释放错误
end;
end;
finally
FConnectionList.UnlockList;
end;
FConnectionList.Free;
CloseHandle(FSemaphore);
inherited Destroy;
end;
function TADOConnectionPool.GetLock(AOwnerList:TList;Index: Integer): Boolean;
begin
Result := not PRemoteConnection(AOwnerList[Index]).InUse;
if Result then
PRemoteConnection(AOwnerList[Index]).InUse := True;
end;
function TADOConnectionPool.LockConnection: TADOConnection;
var
i,WaitResult: Integer;
ConnList:TList;
begin
Result := nil;
WaitResult:= WaitForSingleObject(FSemaphore, Timeout);
if WaitResult = WAIT_FAILED then
raise Exception.Create('Server busy, please try again');
ConnList:=FConnectionList.LockList;
try
try
for i := 0 to ConnList.Count - 1 do
begin
if GetLock(ConnList,i) then
begin
Result := PRemoteConnection(ConnList[i]).Connection;
Exit;
end;
end;
if ConnList.Count < MaxCount then
Result := CreateNewInstance(ConnList);
except
// 获取信号且失败则释放一个信号量
if WaitResult=WAIT_OBJECT_0 then
ReleaseSemaphore(FSemaphore, 1, nil);
raise;
end;
finally
FConnectionList.UnlockList;
end;
if Result = nil then
begin
if WaitResult=WAIT_TIMEOUT then
raise Exception.Create('Timeout expired.Connection pool is full.')
else
{ This shouldn 't happen because of the sempahore locks }
raise Exception.Create('Unable to lock Connection');
end;
end;
procedure TADOConnectionPool.UnlockConnection(var Value: TADOConnection);
var
i: Integer;
ConnList:TList;
begin
ConnList:=FConnectionList.LockList;
try
for i := 0 to ConnList.Count - 1 do
begin
if Value = PRemoteConnection(ConnList[i]).Connection then
begin
PRemoteConnection(ConnList[I]).InUse := False;
ReleaseSemaphore(FSemaphore, 1, nil);
break;
end;
end;
finally
FConnectionList.UnlockList;
end;
end;
initialization
ConnectionPool := TADOConnectionPool.Create();
finalization
ConnectionPool.Free;
end.
3.
[delphi] view plain copy
print?
当连接数多，使用频繁时，用连接池大大提高效率
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.
http://blog.csdn.net/aroc_lo/article/details/22299303
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- MySQL 5.7及以上解压缩版本配置安装
- oracle基本常识
- 如何正确获取MYSQL的ADO连接字符串
- 菜鸟看Redis（一）
- win8更新后mysql服务无法启动
- 某裤子txt格式转存到MySQL
- Redis安装及Java客户端的使用浅析（jedis）
- Redis 3 配置详解
- Redis 3 所有命令
- MongoDB
- 分布式redis服务：codis
- SQL Developer 4.1.3
- SQL Server 入门复习(2008)图解
- Redis与Memcached的区别
- oracle中文乱码，
- 一对一网页聊天 jsp+js+ajax+servlet+tomcat+mysql
- linux下oracle11G R2升级记录
- 跟我一起学习MySQL技术内幕（第五版）：（第二章学习日记6）
- MongoDB
- 关于jdbc的数据库驱动类DriverManager.getConnection()参数