- (*******************************************************************************
- 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
- 如有优化 请传作者一份 。谢谢!
- ********************************************************************************)
- 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;
// AdoConnection连接池的使用(续)
- { 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.