1、
// Writen by 咏南工作室(陈新光) 2009-6-26 11:58:17
// 数据库连接池类
// 使用ADO引擎，支持access, sqlServer, oracle三种数据库
// 连接对象.tag = 正数 表示此连接对象处于非使用状态，否则反之
// 所有时间单位均为秒
unit UDataConnPool;
{$HINTS OFF}
{$WARNINGS OFF}
interface
uses
SysUtils, Classes, DB, ADODB, Contnrs, Windows, ExtCtrls;
// 常量定义
const
c_sql = 'sqloledb';
c_access = 'microsoft.jet.oledb.4.0';
c_oracle = 'MSDAORA.1';
// 自定义数据类型
type
TDBType=(Access, SqlServer, Oracle); // 可支持的数据库类型
RConnParameter = record // 连接池的参数结构体
ConnMin: Integer; // 连接池最小要保留的连接对象数量
ConnMax: Integer; // 连接池最大可拥有的连接对象数量
TimeOut: Integer; // 非使用中连接对象的超时时间
TimeOut2: Integer; // 使用中连接对象的超时时间
RefreshTime: Integer; // 定时轮询连接池的时间
dbSource: string; // data source
DB: string; // sql server 特有 Initial Catalog
dbUser: string; // user id
dbPass: string; // password
dbpass2: string; // access 特有 Database Password
end;
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); // 创建者方法
// owner -- 拥有者
// connParam -- 连接池的参数
// dbType -- 支持的数据库类型
function getConn: TADOConnection; // 从连接池内获取非使用中的连接对象
procedure returnConn(conn: TADOConnection); // 使用完的连接对象归还连接池内
end;
implementation
constructor TDataConnectionPool.Create(owner: TComponent; connParam: RConnParameter; dbType: TDBType);
// owner -- 拥有者
// connParam -- 连接池的参数
// dbType -- 支持的数据库类型
var
index: Integer;
begin
inherited Create(owner);
fDBType := dbType;
fConnParameter := connParam;
if fConnList = nil then
begin
fConnList := TComponentList.Create; // 创建连接池容器
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;
index: Integer;
begin
iNow := GetTickCount; // 获取当前时间
for index := fConnList.Count - 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 * 1000 then // 超时
fConnList.Delete(index); // 从连接池内释放此连接对象
end;
end
else if TADOConnection(fConnList[index]).Tag < 0 then // 使用中的连接
begin
if iNow + TADOConnection(fConnList[index]).Tag > fConnParameter.TimeOut2 * 1000 then // 超时
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; // 连接SQL SERVER
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; // 连接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: // 连接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('Connect database fail.');
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; // 标记该连接为使用状态
Break; // 找到后中止循环
end;
end;
if (Result = nil) and (index < fConnParameter.ConnMax) then // 如果连接池内已经没有可用的连接对象(全部被使用)
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.
2、
池满的情况下 池子ADO连接 动态创建
系统默认池子中 一个小时以上未用的 ADOConnection 连接 系统自动释放
使用如下 先Uses SQLADOPoolUnit 单元
在程序初始化时(initialization)创建连接池类 ADOConfig := TADOConfig.Create('SERVERDB.LXH'); ADOXPool := TADOPool.Create(15);
在程序关闭时(finalization)释放连接池类 ADOPool.Free; ADOConfig.Free;
调用如下
try
ADOQuery.Connecttion:= ADOPool.GetCon(ADOConfig);
ADOQueryt.Open;
finally
ADOPool.PutCon(ADOQuery.Connecttion);
end;
unit SQLADOPoolUnit;
interface
uses
Winapi.Windows,Data.SqlExpr,System.SysUtils, System.Classes,Vcl.ExtCtrls, System.DateUtils,Data.DB, Data.Win.ADODB,System.IniFiles,
Winapi.Messages, Datasnap.Provider, Data.DBXMSSQL;
type// 数据库类型
TDBType=(Access,SqlServer,Oracle);
//数据库配置 ADO
type
TADOConfig = class
//数据库配置
ConnectionName :string;//连接驱动名字
ProviderName :string;//通用驱动
DBServer:string; //数据源 --数据库服务器IP
DataBase :string; //数据库名字 //sql server连接时需要数据库名参数--数据库实例名称
OSAuthentication:Boolean; //是否是windows验证
UserName :string; //数据库用户
PassWord :string; //密码
AccessPassWord:string; //Access可能需要数据库密码
Port:integer;//数据库端口
//
DriverName :string;//驱动
HostName :string;//服务地址
//端口配置
TCPPort:Integer; //TCP端口
HttpPort:Integer; //http 端口
LoginSrvUser:string;//验证中间层服务登录用户
LoginSrvPassword:string;//验证登录模块密码
public
constructor Create(iniFile :String);overload;
destructor Destroy; override;
end;
type
TADOCon = class
private
FConnObj:TADOConnection; //数据库连接对象
FAStart: TDateTime; //最后一次活动时间
function GetUseFlag: Boolean;
procedure SetUseFlag(value: Boolean);
public
constructor Create(ADOConfig :TADOConfig);overload;
destructor Destroy;override;
//当前对象是否被使用
property UseFlag :boolean read GetUseFlag write SetUseFlag ;
property ConnObj :TADOConnection read FConnObj;
property AStart :TDateTime read FAStart write FAStart;
end;
type
TADOPool = class
procedure OnMyTimer(Sender: TObject);//做轮询用
private
FSection :TRTLCriticalSection;
FPoolNumber :Integer; //池大小
FPollingInterval :Integer;//轮询时间 以 分 为单位
FADOCon :TADOCon;
FList :TList; //用来管理连接TADOCobbler
FTime :TTimer; //主要做轮询
procedure Enter;
procedure Leave;
function SameConfig(const Source:TADOConfig; Target:TADOCon):Boolean;
function GetConnectionCount: Integer;
public
constructor Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);overload;
destructor Destroy;override;
//从池中取出可用的连接。
function GetCon(const tmpConfig :TADOConfig):TADOConnection;
//把用完的连接放回连接池。
procedure PutCon(const ADOConnection :TADOConnection);
//释放池中许久未用的连接，由定时器定期扫描执行
procedure FreeConnection;
//当前池中连接数.
property ConnectionCount: Integer read GetConnectionCount;
end;
var
ADOPool: TADOPool;
ADOConfig: TADOConfig;
implementation
{ TADOConfig }
constructor TADOConfig.Create(iniFile :String);
var
DBIniFile: TIniFile;
begin
try
DBIniFile := TIniFile.Create(iniFile);
ConnectionName := DBIniFile.ReadString('Connection','ConnectionName', 'SQLConnection');
DriverName := DBIniFile.ReadString('Connection','DriverName', 'MSDASQL');
ProviderName := DBIniFile.ReadString('Connection','ProviderName', 'MSDASQL');
DBServer:= DBIniFile.ReadString('Connection','DBServer', '127.0.0.1');
HostName := DBIniFile.ReadString('Connection','HostName', '127.0.0.1');
DataBase := DBIniFile.ReadString('Connection','DataBase', 'GPMS2000');
Port:=DBIniFile.ReadInteger('Connection','Port', 1433);
UserName := DBIniFile.ReadString('Connection','UserName', 'Sa');
PassWord := DBIniFile.ReadString('Connection','PassWord', 'Sa');
LoginSrvUser := DBIniFile.ReadString('Connection','LoginSrvUser', 'hyz');
LoginSrvPassword := DBIniFile.ReadString('Connection','LoginSrvPassword', 'hyz');
TCPPort := DBIniFile.ReadInteger('Connection','TCPPort', 211);
HttpPort := DBIniFile.ReadInteger('Connection','HttpPort', 2110);
OSAuthentication := DBIniFile.ReadBool('Connection','OSAuthentication', False);
if Not FileExists(iniFile) then
begin
If Not DirectoryExists(ExtractFilePath(iniFile)) Then ForceDirectories(ExtractFilePath(iniFile));
DBIniFile.WriteString('Connection','ConnectionName', ConnectionName);
DBIniFile.WriteString('Connection','DriverName', DriverName);
DBIniFile.WriteString('Connection','HostName', HostName);
DBIniFile.WriteString('Connection','DBServer', HostName);
DBIniFile.WriteString('Connection','DataBase', DataBase);
// DBIniFile.WriteString('Connection','Port',Port);
DBIniFile.WriteString('Connection','UserName', UserName);
DBIniFile.WriteString('Connection','PassWord', PassWord);
DBIniFile.WriteString('Connection','LoginSrvUser', LoginSrvUser);
DBIniFile.WriteString('Connection','LoginSrvPassword', LoginSrvPassword);
DBIniFile.WriteInteger('Connection','TCPPort', TCPPort);
DBIniFile.WriteInteger('Connection','HttpPort', HttpPort);
DBIniFile.WriteBool('Connection','OSAuthentication', OSAuthentication);
end;
finally
FreeAndNil(DBIniFile);
end;
end;
destructor TADOConfig.Destroy;
begin
inherited;
end;
{ TADOCon }
constructor TADOCon.Create(ADOConfig: TADOConfig);
//var
// str:string;
begin
// str:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID='+ADOConfig.UserName+';password='+ADOConfig.PassWord+';Initial Catalog='+ADOConfig.DataBase+';Data Source='+ADOConfig.DBServer;
FConnObj:=TADOConnection.Create(nil);
with FConnObj do
begin
LoginPrompt:=False;
Tag:=GetTickCount;
ConnectionTimeout:=18000;
Provider:=ADOConfig.ProviderName;
Properties['Data Source'].Value:=ADOConfig.DBServer;
Properties['User ID'].Value:=ADOConfig.UserName;
Properties['Password'].Value:=ADOConfig.PassWord;
Properties['Initial Catalog'].Value:=ADOConfig.DataBase;
// ConnectionString:=str;
try
Connected:=True;
except
raise Exception.Create('数据库连接失败');
end;
end;
end;
destructor TADOCon.Destroy;
begin
FAStart := 0;
if Assigned(FConnObj) then
BEGIN
if FConnObj.Connected then FConnObj.Close;
FreeAndnil(FConnObj);
END;
inherited;
end;
procedure TADOCon.SetUseFlag(value :Boolean);
begin
//False表示闲置，True表示在使用。
if not value then
FConnObj.Tag := 0
else
begin
if FConnObj.Tag = 0 then FConnObj.Tag := 1; //设置为使用标识。
FAStart := now; //设置启用时间 。
end;
end;
Function TADOCon.GetUseFlag :Boolean;
begin
Result := (FConnObj.Tag>0); //Tag=0表示闲置，Tag>0表示在使用。
end;
{ TADOPool }
constructor TADOPool.Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);
begin
InitializeCriticalSection(FSection);
FPOOLNUMBER := MaxNumBer; //设置池大小
FPollingInterval := FreeMinutes;// 连接池中 FPollingInterval 以上没用的 自动回收连接池
FList := TList.Create;
FTime := TTimer.Create(nil);
FTime.Enabled := False;
FTime.Interval := TimerTime;//5秒检查一次
FTime.OnTimer := OnMyTimer;
FTime.Enabled := True;
end;
destructor TADOPool.Destroy;
var
i:integer;
begin
FTime.OnTimer := nil;
FTime.Free;
for i := FList.Count - 1 downto 0 do
begin
try
FADOCon := TADOCon(FList.Items[i]);
if Assigned(FADOCon) then
FreeAndNil(FADOCon);
FList.Delete(i);
except
end;
end;
FList.Free;
DeleteCriticalSection(FSection);
inherited;
end;
procedure TADOPool.Enter;
begin
EnterCriticalSection(FSection);
end;
procedure TADOPool.Leave;
begin
LeaveCriticalSection(FSection);
end;
//根据字符串连接参数 取出当前连接池可以用的TADOConnection
function TADOPool.GetCon(const tmpConfig :TADOConfig):TADOConnection;
var
i:Integer;
IsResult :Boolean; //标识
CurOutTime:Integer;
begin
Result := nil;
IsResult := False;
CurOutTime := 0;
Enter;
try
for I := 0 to FList.Count - 1 do
begin
FADOCon := TADOCon(FList.Items[i]);
if not FADOCon.UseFlag then //可用
if SameConfig(tmpConfig,FADOCon) then //找到
begin
FADOCon.UseFlag := True; //标记已经分配用了
Result := FADOCon.ConnObj;
IsResult := True;
Break;//退出循环
end;
end; // end for
finally
Leave;
end;
if IsResult then Exit;
//池未满 新建一个
Enter;
try
if FList.Count < FPOOLNUMBER then //池未满
begin
FADOCon := TADOCon.Create(tmpConfig);
FADOCon.UseFlag := True;
Result := FADOCon.ConnObj;
IsResult := True;
FList.Add(FADOCon);//加入管理队列
end;
finally
Leave;
end;
if IsResult then Exit;
//池满 等待 等候释放
while True do
begin
Enter;
try
for I := 0 to FList.Count - 1 do
begin
FADOCon := TADOCon(FList.Items[i]);
if SameConfig(tmpConfig,FADOCon) then //找到
if not FADOCon.UseFlag then //可用
begin
FADOCon.UseFlag := True; //标记已经分配用了
Result := FADOCon.ConnObj;
IsResult := True;
Break;//退出循环
end;
end; // end for
if IsResult then Break; //找到退出
finally
Leave;
end;
//如果不存在这种字符串的池子 则 一直等到超时
if CurOutTime >= 5000 * 6 then //1分钟
begin
raise Exception.Create('连接超时!');
Break;
end;
Sleep(500);//0.5秒钟
CurOutTime := CurOutTime + 500; //超时设置成60秒
end;//end while
end;
procedure TADOPool.PutCon(const ADOConnection :TADOConnection);
var i :Integer;
begin
{
if not Assigned(ADOConnection) then Exit;
try
Enter;
ADOConnection.Tag := 0; //如此应该也可以 ，未测试...
finally
Leave;
end;
}
Enter; //并发控制
try
for I := FList.Count - 1 downto 0 do
begin
FADOCon := TADOCon(FList.Items[i]);
if FADOCon.ConnObj=ADOConnection then
begin
FADOCon.UseFlag := False;
Break;
end;
end;
finally
Leave;
end;
end;
procedure TADOPool.FreeConnection;
var
i:Integer;
function MyMinutesBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Round(MinuteSpan(ANow, AThen));
end;
begin
Enter;
try
for I := FList.Count - 1 downto 0 do
begin
FADOCon := TADOCon(FList.Items[i]);
if MyMinutesBetween(Now,FADOCon.AStart) >= FPollingInterval then //释放池子许久不用的ADO
begin
FreeAndNil(FADOCon);
FList.Delete(I);
end;
end;
finally
Leave;
end;
end;
procedure TADOPool.OnMyTimer(Sender: TObject);
begin
FreeConnection;
end;
function TADOPool.SameConfig(const Source:TADOConfig;Target:TADOCon): Boolean;
begin
//考虑到支持多数据库连接，需要本方法做如下等效连接判断.如果是单一数据库，可忽略本过程。
{ Result := False;
if not Assigned(Source) then Exit;
if not Assigned(Target) then Exit;
Result := SameStr(LowerCase(Source.ConnectionName),LowerCase(Target.ConnObj.Name));
Result := Result and SameStr(LowerCase(Source.DriverName),LowerCase(Target.ConnObj.Provider));
Result := Result and SameStr(LowerCase(Source.HostName),LowerCase(Target.ConnObj.Properties['Data Source'].Value));
Result := Result and SameStr(LowerCase(Source.DataBase),LowerCase(Target.ConnObj.Properties['Initial Catalog'].Value));
Result := Result and SameStr(LowerCase(Source.UserName),LowerCase(Target.ConnObj.Properties['User ID'].Value));
Result := Result and SameStr(LowerCase(Source.PassWord),LowerCase(Target.ConnObj.Properties['Password'].Value));
//Result := Result and (Source.OSAuthentication = Target.ConnObj.OSAuthentication);
}
end;
Function TADOPool.GetConnectionCount :Integer;
begin
Result := FList.Count;
end;
//初始化时创建对象
initialization
//ini文件后缀更名为LXH，方便远程安全下载更新
ADOConfig := TADOConfig.Create(ExtractFilePath(ParamStr(0))+'SERVERDB.LXH');
ADOPool := TADOPool.Create(15);
finalization
if Assigned(ADOPool) then ADOPool.Free;
if Assigned(ADOConfig) then ADOConfig.Free;
end.
//在程序初始化时(initialization)创建连接池类
initialization
ADOConfig := TADOConfig.Create('SERVERDB.ini');
ADOXPool := TADOPool.Create(15);
//在程序关闭时(finalization)释放连接池类
finalization
if assigned(ADOPool) then FreeAndNil(ADOPool);
if assigned(ADOConfig) then FreeAndNil(ADOConfig);
3、
当连接数多，使用频繁时，用连接池大大提高效率
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.
4、
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
if assigned(ConnectionPool) then FreeAndNil(ConnectionPool);
end.
