ADOConnection数据库连接池
- 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做服务器端如果每次请求都创建一个连接就太耗资源了,而使用一个全局的连接那效率可想而知,这样就体现出了线程池的重要了。参考一些例子做了个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.
- 当连接数多,使用频繁时,用连接池大大提高效率
- 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
ADOConnection数据库连接池的更多相关文章
- Java第三方数据库连接池库-DBCP-C3P0-Tomcat内置连接池
连接池原理 数据库连接池的基本思想就是为数据库连接建立一个“缓冲池”.预先在缓冲池中放入一定数量的连接,当需要建立数据库连接时,只需从“缓冲池”中取出一个,使用完毕之后再放回去.我们可以通过设定连接池 ...
- .数据库连接池技术:DBCP和C3P0
数据库连接池技术:DBCP和C3P0 1.什么是数据库连接池 已知的方法是需要访问数据库的时候进行一次数据库的连接,对数据库操作完之后再释放这个连接,通常这样业务是缺点很明显的: 用户每次请求都需要向 ...
- [转]阿里巴巴数据库连接池 druid配置详解
一.背景 java程序很大一部分要操作数据库,为了提高性能操作数据库的时候,又不得不使用数据库连接池.数据库连接池有很多选择,c3p.dhcp.proxool等,druid作为一名后起之秀,凭借其出色 ...
- 数据库连接池c3p0学习
这里只记录c3p0的数据源,不会涉及到其它方面和别的数据库连接池的对比 配置文件主要的实现方式有三种: 1.手写代码去加载一个配置文件 创建一个config.properties文件如下: drive ...
- <十四>JDBC_c3p0数据库连接池
配置文件:c3p0-config.xml <!-- Hibernate官方推荐使用的数据库连接池即c3p0;dbcp是Tomcat在数据源中使用 --><c3p0-config> ...
- <十三>JDBC_dbcp数据库连接池
配置文件:jdbc.properties username=rootpassword=kkdriverClassName=com.mysql.jdbc.Driverurl=jdbc:mysql://1 ...
- c3p0数据库连接池的使用详解
首先,什么是c3p0?下面是百度百科的解释: C3P0是一个开源的JDBC连接池,它实现了数据源和JNDI绑定,支持JDBC3规范和JDBC2的标准扩展.目前使用它的开源项目有Hibernate,Sp ...
- Mybatis-update - 数据库死锁 - 获取数据库连接池等待
最近学习测试mybatis,单个增删改查都没问题,最后使用mvn test的时候发现了几个问题: update失败,原因是数据库死锁 select等待,原因是connection连接池被用光了,需要等 ...
- 从零开始学 Java - 数据库连接池的选择 Druid
我先说说数据库连接 数据库大家都不陌生,从名字就能看出来它是「存放数据的仓库」,那我们怎么去「仓库」取东西呢?当然需要钥匙啦!这就是我们的数据库用户名.密码了,然后我们就可以打开门去任意的存取东西了. ...
随机推荐
- Unbuntu 14.04 下chrome browser bookmark 显示中文乱码解决方案
来源:http://blog.csdn.net/loveaborn/article/details/29579787 网上有人给出这个问题的解决是通过修改文件/etc/fonts/conf.d/49- ...
- double 型变量的输入输出标准格式
c语言double型变量标准输入格式: scanf("%lf",num); 标准输出格式: printf("%f\n",num); 注:有过输出用%lf输出OJ ...
- AzureDev 社区活动获奖者公布
今天,我们高兴地宣布 AzureDev社区活动的获奖者,并向这 5 个非盈利技术教育组织发放 10 万美元奖金.在 2013 年的Build大会上宣布的 AzureDev 活动专注于通过代码改变世界, ...
- 基于visual Studio2013解决C语言竞赛题之0513字符拷贝
题目 解决代码及点评 /************************************************************************/ /* 13. 将字符数 ...
- hdu 4885 TIANKENG’s travel(bfs)
题目链接:hdu 4885 TIANKENG's travel 题目大意:给定N,L,表示有N个加油站,每次加满油能够移动距离L,必须走直线,可是能够为斜线.然后给出sx,sy,ex,ey,以及N个加 ...
- AsyncTask究竟需要多少个线程
最起码两个:主线程和工作线程; 可以参考:http://zhidao.baidu.com/link?url=ho4UEcEbaogRZUFHwig1neSKR25b2zT9iXyM36hEgWTmvJ ...
- 3522: [Poi2014]Hotel( 树形dp )
枚举中点x( 即选出的三个点 a , b , c 满足 dist( x , a ) = dist( x , b ) = dist( x , c ) ) , 然后以 x 为 root 做 dfs , 显 ...
- 知识点3-6:HTML辅助方法
顾名思义,HTML辅助方法(HTML Helper)就是用来辅助产生HTML之用,在开发View的时候一定会面对许多HTML标签,处理这些HTML的工作非常繁琐,为了降低View的复杂度,可以使用HT ...
- WCF技术剖析之二十七: 如何将一个服务发布成WSDL[基于WS-MEX的实现](提供模拟程序)
原文:WCF技术剖析之二十七: 如何将一个服务发布成WSDL[基于WS-MEX的实现](提供模拟程序) 通过<如何将一个服务发布成WSDL[编程篇]>的介绍我们知道了如何可以通过编程或者配 ...
- zookeeper 之znode 节点
<pre name="code" class="html">使用 ls 命令来查看当前 ZooKeeper 中所包含的内容: [zk: 10.77. ...