ado 连接池 oracle,AdoConnection连接池的使用

(*******************************************************************************

ADOConnection连接池

池满的情况下 池子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;

作者:何应祖(QQ:306446305)

2012-10

如有优化 请传作者一份 。谢谢！

********************************************************************************)

unitSQLADOPoolUnit;

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

constructorCreate(iniFile :String);overload;

destructorDestroy; override;

end;

type

TADOCon = class

private

FConnObj:TADOConnection;  //数据库连接对象

FAStart: TDateTime;        //最后一次活动时间

functionGetUseFlag: Boolean;

procedureSetUseFlag(value: Boolean);

public

constructorCreate(ADOConfig :TADOConfig);overload;

destructorDestroy;override;

//当前对象是否被使用

propertyUseFlag :booleanread GetUseFlagwriteSetUseFlag ;

propertyConnObj :TADOConnection read FConnObj;

propertyAStart :TDateTime read FAStartwriteFAStart;

end;

type

TADOPool = class

procedureOnMyTimer(Sender: TObject);//做轮询用

private

FSection :TRTLCriticalSection;

FPoolNumber :Integer;     //池大小

FPollingInterval :Integer;//轮询时间 以 分 为单位

FADOCon :TADOCon;

FList :TList;             //用来管理连接TADOCobbler

FTime :TTimer;            //主要做轮询

procedureEnter;

procedureLeave;

functionSameConfig(constSource:TADOConfig; Target:TADOCon):Boolean;

functionGetConnectionCount: Integer;

public

constructorCreate(constMaxNumBer:Integer;FreeMinutes :Integer=60;TimerTime:Integer =5000);overload;

destructorDestroy;override;

//从池中取出可用的连接。

functionGetCon(consttmpConfig :TADOConfig):TADOConnection;

//把用完的连接放回连接池。

procedurePutCon(constADOConnection :TADOConnection);

//释放池中许久未用的连接，由定时器定期扫描执行

procedureFreeConnection;

//当前池中连接数.

propertyConnectionCount: Integer read GetConnectionCount;

end;

var

ADOPool: TADOPool;

ADOConfig: TADOConfig;

implementation

{ TADOConfig }

constructorTADOConfig.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);

ifNot 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;

destructorTADOConfig.Destroy;

begin

inherited;

end;

{ TADOCon }

constructorTADOCon.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);

withFConnObjdo

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

raiseException.Create('数据库连接失败');

end;

end;

end;

destructorTADOCon.Destroy;

begin

FAStart := 0;

ifAssigned(FConnObj)then

BEGIN

ifFConnObj.ConnectedthenFConnObj.Close;

FreeAndnil(FConnObj);

END;

inherited;

end;

procedureTADOCon.SetUseFlag(value :Boolean);

begin

//False表示闲置，True表示在使用。

ifnotvaluethen

FConnObj.Tag :=0

else

begin

ifFConnObj.Tag =0thenFConnObj.Tag :=1;//设置为使用标识。

FAStart := now;                              //设置启用时间 。

end;

end;

Function TADOCon.GetUseFlag :Boolean;

begin

Result := (FConnObj.Tag>0);//Tag=0表示闲置，Tag>0表示在使用。

end;

{ TADOPool }

constructorTADOPool.Create(constMaxNumBer: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;

destructorTADOPool.Destroy;

var

i:integer;

begin

FTime.OnTimer :=nil;

FTime.Free;

fori := FList.Count -1downto0do

begin

try

FADOCon := TADOCon(FList.Items[i]);

ifAssigned(FADOCon)then

FreeAndNil(FADOCon);

FList.Delete(i);

except

end;

end;

FList.Free;

DeleteCriticalSection(FSection);

inherited;

end;

procedureTADOPool.Enter;

begin

EnterCriticalSection(FSection);

end;

procedureTADOPool.Leave;

begin

LeaveCriticalSection(FSection);

end;

//根据字符串连接参数 取出当前连接池可以用的TADOConnection

functionTADOPool.GetCon(consttmpConfig :TADOConfig):TADOConnection;

var

i:Integer;

IsResult :Boolean; //标识

CurOutTime:Integer;

begin

Result := nil;

IsResult := False;

CurOutTime := 0;

Enter;

try

forI :=0toFList.Count -1do

begin

FADOCon := TADOCon(FList.Items[i]);

ifnotFADOCon.UseFlagthen//可用

ifSameConfig(tmpConfig,FADOCon)then//找到

begin

FADOCon.UseFlag := True;//标记已经分配用了

Result :=  FADOCon.ConnObj;

IsResult := True;

Break;//退出循环

end;

end;// end for

finally

Leave;

end;

ifIsResultthenExit;

//池未满 新建一个

Enter;

try

ifFList.Count 

begin

FADOCon := TADOCon.Create(tmpConfig);

FADOCon.UseFlag := True;

Result :=  FADOCon.ConnObj;

IsResult := True;

FList.Add(FADOCon);//加入管理队列

end;

finally

Leave;

end;

ifIsResultthenExit;

//池满 等待 等候释放

whileTruedo

begin

Enter;

try

forI :=0toFList.Count -1do

begin

FADOCon := TADOCon(FList.Items[i]);

ifSameConfig(tmpConfig,FADOCon)then//找到

ifnotFADOCon.UseFlagthen//可用

begin

FADOCon.UseFlag := True;//标记已经分配用了

Result :=  FADOCon.ConnObj;

IsResult := True;

Break;//退出循环

end;

end;// end for

ifIsResultthenBreak;//找到退出

finally

Leave;

end;

//如果不存在这种字符串的池子 则 一直等到超时

ifCurOutTime >=5000*6then//1分钟

begin

raiseException.Create('连接超时!');

Break;

end;

Sleep(500);//0.5秒钟

CurOutTime := CurOutTime + 500;//超时设置成60秒

end;//end while

end;

procedureTADOPool.PutCon(constADOConnection :TADOConnection);

vari :Integer;

begin

{

if not Assigned(ADOConnection) then Exit;

try

Enter;

ADOConnection.Tag := 0;  //如此应该也可以 ，未测试...

finally

Leave;

end;

}

Enter;  //并发控制

try

forI := FList.Count -1downto0do

begin

FADOCon := TADOCon(FList.Items[i]);

ifFADOCon.ConnObj=ADOConnectionthen

begin

FADOCon.UseFlag := False;

Break;

end;

end;

finally

Leave;

end;

end;

procedureTADOPool.FreeConnection;

var

i:Integer;

functionMyMinutesBetween(constANow, AThen: TDateTime): Integer;

begin

Result := Round(MinuteSpan(ANow, AThen));

end;

begin

Enter;

try

forI := FList.Count -1downto0do

begin

FADOCon := TADOCon(FList.Items[i]);

ifMyMinutesBetween(Now,FADOCon.AStart) >= FPollingIntervalthen//释放池子许久不用的ADO

begin

FreeAndNil(FADOCon);

FList.Delete(I);

end;

end;

finally

Leave;

end;

end;

procedureTADOPool.OnMyTimer(Sender: TObject);

begin

FreeConnection;

end;

functionTADOPool.SameConfig(constSource: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

ifAssigned(ADOPool)thenADOPool.Free;

ifAssigned(ADOConfig)thenADOConfig.Free;

end.