DELPHI的FireDac连接池单元

最爱巴菲特 發表於 2021-7-26 14:39:00

(******************************************************************************* FireDac连接池 ******************************************************************************* 池满的情况下池子DAC连接动态创建 系统默认池子中一个小时以上未用的 TFDConnection 连接系统自动释放 使用如下 先Uses SQLFirDACPoolUnit 单元 在程序初始化时(initialization)创建连接池类 DAConfig := TDAConfig.Create('YxDServer.ini'); DACPool := TDACPool.Create(32); 在程序关闭时(finalization)释放连接池类 DACPool.Free; DAConfig.Free; 调用如下 try FDQuery.Connecttion:= DACPool.GetCon(DAConfig); FDQuery.Open; finally DACPool.PutCon(FDQuery.Connecttion); end; QQ:2405414352 2021-3 如有优化请传一份。谢谢！ ********************************************************************************* 代码源自：作者:何应祖--SQLADOPoolUnit.pas ********************************************************************************)
unit SQLFirDACPoolUnit;
interface
uses Windows, SqlExpr, SysUtils, Classes, ExtCtrls, DateUtils, IniFiles, uEncry, Messages, Provider, FireDAC.Comp.Client, FireDAC.Phys.MSSQL, FireDAC.DApt,FireDAC.Moni.FlatFile,FireDAC.Stan.Intf, FireDAC.Moni.Base,QLog;
type// 数据库类型 TDBType = (Access, SqlServer, Oracle); //数据库配置 DAC
type TDAConfig = class private //数据库配置 ConnectionName: string; //连接驱动名字 ProviderName: string; //通用驱动 DBServer: ansistring; //数据源 --数据库服务器IP DataBase: ansistring; //数据库名字 //sql server连接时需要数据库名参数--数据库实例名称 OSAuthentication: Boolean; //是否是windows验证 UserName: ansistring; //数据库用户 PassWord: ansistring; //密码 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 TDACon = class private FConnObj: TFDConnection; //数据库连接对象 FAStart: TDateTime; //最后一次活动时间 function GetUseFlag: Boolean; procedure SetUseFlag(value: Boolean); procedure FDMFFOutput(ASender: TFDMoniClientLinkBase; const AClassName, AObjName, AMessage: string); public constructor Create(DAConfig: TDAConfig); overload; destructor Destroy; override; //当前对象是否被使用 property UseFlag: boolean read GetUseFlag write SetUseFlag; property ConnObj: TFDConnection read FConnObj; property AStart: TDateTime read FAStart write FAStart; end;
type TDACPool = class procedure OnMyTimer(Sender: TObject); //做轮询用 private //FSection: TRTLCriticalSection; FPoolNumber: Integer; //池大小 FPollingInterval: Integer; //轮询时间以分为单位 FDACon: TDACon; FList: TList; //用来管理连接 FTime: TTimer; //主要做轮询 procedure Enter; procedure Leave; function SameConfig(const Source: TDAConfig; Target: TDACon): Boolean; function GetConnectionCount: Integer; public constructor Create(const MaxNumBer: Integer; FreeMinutes: Integer = 60; TimerTime: Integer = 5000); overload; destructor Destroy; override; //从池中取出可用的连接。 function GetCon(const tmpConfig: TDAConfig): TFDConnection; //把用完的连接放回连接池。 procedure PutCon(const DAConnection: TFDConnection); //释放池中许久未用的连接，由定时器定期扫描执行 procedure FreeConnection; //当前池中连接数. property ConnectionCount: Integer read GetConnectionCount; end;
var DACPool: TDACPool; DAConfig: TDAConfig; PoolNum: Integer = 32;
implementation { TDAConfig }
constructor TDAConfig.Create(iniFile: string); var AINI: TIniFile; begin try AINI := TIniFile.Create(iniFile); DBServer := AINI.ReadString('DB', 'Server', ''); DataBase := AINI.ReadString('DB', 'DataBase', ''); DBServer := DeCode(AINI.ReadString('DB', 'Server', '')); DataBase := DeCode(AINI.ReadString('DB', 'DataBase', '')); UserName := DeCode(AINI.ReadString('DB', 'UserName', '')); PassWord := DeCode(AINI.ReadString('DB', 'PassWord', '')); PoolNum := AINI.ReadInteger('YxCisSvr', 'Pools', 32); finally Freeandnil(AINI); end;
end;
destructor TDAConfig.Destroy; begin inherited; end; { tdacon }
procedure TDACon.FDMFFOutput(ASender: TFDMoniClientLinkBase; const AClassName, AObjName, AMessage: string); begin PostLog(llDebug,AMessage); end;
constructor TDACon.Create(DAConfig: TDAConfig); var str: string; begin str := 'DriverID=MSSQL;Server=' + DAConfig.DBServer + ';Database=' + DAConfig.DataBase + ';User_name=' + DAConfig.UserName + ';Password=' + DAConfig.PassWord; FConnObj := TFDConnection.Create(nil); with FConnObj do begin //ConnectionTimeout:=18000; ConnectionString := str; //解决执行sql过程断线，等待时间过程 ,加上之后，数据量过大写入会超时！屏蔽！ //Params.add('ResourceOptions.CmdExecTimeout=3'); //解决查询只返回50条数据问题 Params.add('FetchOptions.Mode=fmAll'); //解决！，&等字符插入数据库时丢失 Params.add('ResourceOptions.MacroCreate=False'); Params.add('ResourceOptions.MacroExpand=False'); //////////SQL日志设置///////// //Params.add('MonitorBy=FlatFile'); //Params.add('ConnectionIntf.Tracing=True'); //FileName := ''; //EventKinds := ; //ShowTraces := False; //OnOutput := FDMFFOutput; //try //FileEncoding := ecANSI; //Except //raise Exception.Create('正在初始化SQL跟踪日志！请重新提交数据！'); //end; /////////////////////////// try Connected := True; //Tracing := DAConfig.BDEBUG; except raise Exception.Create('数据库连接失败！请检查数据库配置或者网络链接！'); end; end; end;
destructor tdacon.Destroy; begin FAStart := 0; if Assigned(FConnObj) then begin if FConnObj.Connected then FConnObj.Close; FreeAndnil(FConnObj); end; inherited; end;
procedure tdacon.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 tdacon.GetUseFlag: Boolean; begin Result := (FConnObj.Tag > 0); //Tag=0表示闲置，Tag>0表示在使用。 end; { TDACPool }
constructor TDACPool.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 TDACPool.Destroy; var i: integer; begin FTime.OnTimer := nil; FTime.Free; for i := FList.Count - 1 downto 0 do begin try FDACon := TDAcon(FList.Items); if Assigned(FDACon) then FreeAndNil(FDACon); FList.Delete(i); except end; end; FList.Free; //DeleteCriticalSection(FSection); inherited; end;
procedure TDACPool.Enter; begin //EnterCriticalSection(FSection); if Assigned(Self) then MonitorEnter(Self); end;
procedure TDACPool.Leave; begin //LeaveCriticalSection(FSection); if Assigned(Self) then MonitorExit(Self); end;
//根据字符串连接参数取出当前连接池可以用的tdaconnection
function TDACPool.GetCon(const tmpConfig: TDAConfig): TFDConnection; 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 FDACon := TDACon(FList.Items); if not FDACon.UseFlag then //可用 //if SameConfig(tmpConfig, FDACon) then //找到 begin FDACon.UseFlag := True; //标记已经分配用了 Result := FDACon.ConnObj; IsResult := True; Break; //退出循环 end; end; // end for finally Leave; end; if IsResult then Exit; //池未满新建一个 Enter; try if FList.Count < FPOOLNUMBER then //池未满 begin FDACon := tdacon.Create(tmpConfig); FDACon.UseFlag := True; Result := FDACon.ConnObj; IsResult := True; FList.Add(FDACon); //加入管理队列 end; finally Leave; end; if IsResult then Exit; //池满等待等候释放 while True do begin Enter; try for i := 0 to FList.Count - 1 do begin FDACon := tdacon(FList.Items); //if SameConfig(tmpConfig, FDACon) then //找到 if not FDACon.UseFlag then //可用 begin FDACon.UseFlag := True; //标记已经分配用了 Result := FDACon.ConnObj; IsResult := True; Break; //退出循环 end; end; // end for if IsResult then Break; //找到退出 finally Leave; end; //如果不存在这种字符串的池子则一直等到超时 if CurOutTime >= 5000 * 6 then //30s begin raise Exception.Create('未找到可用的连接！连接超时!'); Break; end; Sleep(500); //0.5秒钟 CurOutTime := CurOutTime + 500; //超时设置成30秒 end; //end while end;
procedure TDACPool.PutCon(const DAConnection: TFDConnection); var i: Integer; begin { if not Assigned(DAConnection) then Exit; try Enter; DAConnection.Tag := 0; //如此应该也可以，未测试... finally Leave; end; } Enter; //并发控制 try for i := FList.Count - 1 downto 0 do begin FDACon := tdacon(FList.Items); if FDACon.ConnObj = DAConnection then begin FDACon.UseFlag := False; Break; end; end; finally Leave; end; end;
procedure TDACPool.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 FDACon := tdacon(FList.Items); if MyMinutesBetween(Now, FDACon.AStart) >= FPollingInterval then //释放池子许久不用的DAC begin FreeAndNil(FDACon); FList.Delete(i); end; end; finally Leave; end; end;
procedure TDACPool.OnMyTimer(Sender: TObject); begin FreeConnection; end;
function TDACPool.SameConfig(const Source: TDAConfig; Target: TDACon): 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 TDACPool.GetConnectionCount: Integer; begin Result := FList.Count; end; //初始化时创建对象
initialization DAConfig := TDAConfig.Create(ChangeFileExt(ParamStr(0), '.ini')); DACPool := TDACPool.Create(PoolNum);
finalization if Assigned(DACPool) then DACPool.Free; if Assigned(DAConfig) then DAConfig.Free;
end.
  
来源：https://www.cnblogs.com/Yang-YaChao/p/15061341.html

頁: [1]

琼殿技术论坛's Archiver

DELPHI的FireDac连接池单元