ADOConnection数据库连接池

[delphi] view plain copy
 
 print?在CODE上查看代码片派生到我的代码片
  1. unit AdoconnectPool;  
  2.   
  3. interface  
  4.   
  5. uses  
  6.   Classes, Windows, SysUtils, ADODB, IniFiles, forms;  
  7.   
  8. type  
  9.   TADOConnectionPool = class(TObject)  
  10.   private  
  11.     FObjList:TThreadList;  
  12.     FTimeout: Integer;  
  13.     FMaxCount: Integer;  
  14.     FSemaphore: Cardinal;  
  15.     function CreateNewInstance(List:TList): TADOConnection;  
  16.     function GetLock(List:TList;Index: Integer): Boolean;  
  17.   public  
  18.     property Timeout:Integer read FTimeout write FTimeout;  
  19.     property MaxCount:Integer read FMaxCount;  
  20.   
  21.     constructor Create(ACapicity:Integer=30);overload;  
  22.     destructor Destroy;override;  
  23.     function Lock: TADOConnection;  
  24.     procedure Unlock(var Value: TADOConnection);  
  25.   end;  
  26.   
  27. var  
  28.   ConnPool: TADOConnectionPool;  
  29.   g_ini: TIniFile;  
  30.   
  31. implementation  
  32.   
  33. constructor TADOConnectionPool.Create(ACapicity:Integer=30);  
  34. begin  
  35.   FObjList:=TThreadList.Create;  
  36.   FTimeout := 3000;              // 3 second  
  37.   FMaxCount := ACapicity;  
  38.   FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);  
  39. end;  
  40.   
  41. function TADOConnectionPool.CreateNewInstance(List:TList): TADOConnection;  
  42. var  
  43.   p: TADOConnection;  
  44.    
  45.   function GetConnStr: string;  
  46.   begin  
  47.     try  
  48.       Result := g_ini.ReadString('ado','connstr','');  
  49.     except  
  50.       Exit;  
  51.     end;  
  52.   end;  
  53. begin  
  54.   try  
  55.     p := TADOConnection.Create(nil);  
  56.     p.ConnectionString := GetConnStr;  
  57.     p.LoginPrompt := False;  
  58.     p.Connected:=True;  
  59.     p.Tag := 1;  
  60.     List.Add(p);  
  61.     Result := p;  
  62.   except  
  63.     on E: Exception do  
  64.     begin  
  65.       Result := nil;  
  66.       Exit;  
  67.     end;  
  68.   end;  
  69. end;  
  70.   
  71. destructor TADOConnectionPool.Destroy;  
  72. var  
  73.   i: Integer;  
  74.   List:TList;  
  75. begin  
  76.   List:=FObjList.LockList;  
  77.   try  
  78.     for i := List.Count - 1 downto 0 do  
  79.     begin  
  80.       TADOConnection(List[i]).Free;  
  81.     end;  
  82.   finally  
  83.     FObjList.UnlockList;  
  84.   end;  
  85.   FObjList.Free;  
  86.   FObjList := nil;  
  87.   CloseHandle(FSemaphore);  
  88.   inherited;  
  89. end;  
  90.   
  91. function TADOConnectionPool.GetLock(List:TList;Index: Integer): Boolean;  
  92. begin  
  93.   try  
  94.     Result := TADOConnection(List[Index]).Tag = 0;  
  95.     if Result then  
  96.       TADOConnection(List[Index]).Tag := 1;  
  97.   except  
  98.     Result :=False;  
  99.     Exit;  
  100.   end;  
  101. end;  
  102.   
  103. function TADOConnectionPool.Lock: TADOConnection;  
  104. var  
  105.   i: Integer;  
  106.   List:TList;  
  107. begin  
  108.   try  
  109.     Result :=nil;  
  110.     if WaitForSingleObject(FSemaphore, Timeout) = WAIT_FAILED then Exit;  
  111.     List:=FObjList.LockList;  
  112.     try  
  113.       for i := 0 to List.Count - 1 do  
  114.       begin  
  115.         if GetLock(List,i) then  
  116.         begin  
  117.           Result := TADOConnection(List[i]);  
  118.           PostMessage(Application.MainForm.Handle,8888,13,0);  
  119.           Exit;  
  120.         end;  
  121.       end;  
  122.       if List.Count < MaxCount then  
  123.       begin  
  124.         Result := CreateNewInstance(List);  
  125.         PostMessage(Application.MainForm.Handle,8888,11,0);  
  126.       end;  
  127.     finally  
  128.       FObjList.UnlockList;  
  129.     end;  
  130.   except  
  131.     Result := nil;  
  132.     Exit;  
  133.   end;  
  134. end;  
  135.   
  136. procedure TADOConnectionPool.Unlock(var Value: TADOConnection);  
  137. var  
  138.   List:TList;  
  139. begin  
  140.   try  
  141.     List:=FObjList.LockList;  
  142.     try  
  143.       TADOConnection(List[List.IndexOf(Value)]).Tag :=0;  
  144.       ReleaseSemaphore(FSemaphore, 1, nil);  
  145.     finally  
  146.       FObjList.UnlockList;  
  147.     end;  
  148.     PostMessage(Application.MainForm.Handle, 8888, 12, 0);  
  149.   except  
  150.     Exit;  
  151.   end;  
  152. end;  
  153.   
  154. initialization  
  155.   ConnPool := TADOConnectionPool.Create();  
  156.   g_ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'server.ini');  
  157. finalization  
  158.   FreeAndNil(ConnPool);  
  159.   FreeAndNil(g_ini);  
  160.   
  161. end.  


2.

[delphi] view plain copy
 
 print?在CODE上查看代码片派生到我的代码片
  1. 　Delphi做服务器端如果每次请求都创建一个连接就太耗资源了，而使用一个全局的连接那效率可想而知，这样就体现出了线程池的重要了。参考一些例子做了个ADO的连接池，用到项目中挺不错的，分享下。  
  2.    
  3. { ******************************************************* }  
  4. { Description : ADO连接池                                 }  
  5. { Create Date : 2010-8-31 23:22:09                        }  
  6. { Modify Remark :2010-9-1 12:00:09                                           }  
  7. { Modify Date :                                           }  
  8. { Version : 1.0                                           }  
  9. { ******************************************************* }  
  10.    
  11. unit ADOConnectionPool;  
  12.    
  13. interface  
  14.    
  15. uses  
  16.   Classes, Windows, SyncObjs, SysUtils, ADODB;  
  17.    
  18. type  
  19.   TADOConnectionPool = class(TObject)  
  20.   private  
  21.     FConnectionList:TThreadList;  
  22.     //FConnList: TList;  
  23.     FTimeout: Integer;  
  24.     FMaxCount: Integer;  
  25.     FSemaphore: Cardinal;  
  26.     //FCriticalSection: TCriticalSection;  
  27.     FConnectionString,  
  28.     FDataBasePass,  
  29.     FDataBaseUser:string;  
  30.     function CreateNewInstance(AOwnerList:TList): TADOConnection;  
  31.     function GetLock(AOwnerList:TList;Index: Integer): Boolean;  
  32.   public  
  33.     property ConnectionString:string read FConnectionString write FConnectionString;  
  34.     property DataBasePass:string read FDataBasePass write FDataBasePass;  
  35.     property DataBaseUser:string read FDataBaseUser write FDataBaseUser;  
  36.     property Timeout:Integer read FTimeout write FTimeout;  
  37.     property MaxCount:Integer read FMaxCount;  
  38.    
  39.     constructor Create(ACapicity:Integer=15);overload;  
  40.     destructor Destroy;override;  
  41.     /// <summary>  
  42.     /// 申请并一个连接并上锁，使用完必须调用UnlockConnection来释放锁  
  43.     /// </summary>  
  44.     function LockConnection: TADOConnection;  
  45.     /// <summary>  
  46.     /// 释放一个连接  
  47.     /// </summary>  
  48.     procedure UnlockConnection(var Value: TADOConnection);  
  49.   end;  
  50.    
  51. type  
  52.   PRemoteConnection=^TRemoteConnection;  
  53.   TRemoteConnection=record  
  54.     Connection : TADOConnection;  
  55.     InUse:Boolean;  
  56.   end;  
  57.    
  58. var  
  59.   ConnectionPool: TADOConnectionPool;  
  60.    
  61. implementation  
  62.    
  63. constructor TADOConnectionPool.Create(ACapicity:Integer=15);  
  64. begin  
  65.   //FConnList := TList.Create;  
  66.   FConnectionList:=TThreadList.Create;  
  67.   //FCriticalSection := TCriticalSection.Create;  
  68.   FTimeout := 15000;  
  69.   FMaxCount := ACapicity;  
  70.   FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);  
  71. end;  
  72.    
  73. function TADOConnectionPool.CreateNewInstance(AOwnerList:TList): TADOConnection;  
  74. var  
  75.   p: PRemoteConnection;  
  76. begin  
  77.   Result := nil;  
  78.    
  79.   New(p);  
  80.   p.Connection := TADOConnection.Create(nil);  
  81.   p.Connection.ConnectionString := ConnectionString;  
  82.   p.Connection.LoginPrompt := False;  
  83.   try  
  84.     if (DataBaseUser='') and (DataBasePass='') then  
  85.       p.Connection.Connected:=True  
  86.     else  
  87.       p.Connection.Open(DataBaseUser, DataBasePass);  
  88.   except  
  89.     p.Connection.Free;  
  90.     Dispose(p);  
  91.     raise;  
  92.     Exit;  
  93.   end;  
  94.   p.InUse := True;  
  95.   AOwnerList.Add(p);  
  96.   Result := p.Connection;  
  97. end;  
  98.    
  99. destructor TADOConnectionPool.Destroy;  
  100. var  
  101.   i: Integer;  
  102.   ConnList:TList;  
  103. begin  
  104.   //FCriticalSection.Free;  
  105.   ConnList:=FConnectionList.LockList;  
  106.   try  
  107.     for i := ConnList.Count - 1 downto 0 do  
  108.     begin  
  109.       try  
  110.         PRemoteConnection(ConnList[i]).Connection.Free;  
  111.         Dispose(ConnList[i]);  
  112.       except  
  113.         //忽略释放错误  
  114.       end;  
  115.     end;  
  116.   finally  
  117.     FConnectionList.UnlockList;  
  118.   end;  
  119.    
  120.   FConnectionList.Free;  
  121.   CloseHandle(FSemaphore);  
  122.   inherited Destroy;  
  123. end;  
  124.    
  125. function TADOConnectionPool.GetLock(AOwnerList:TList;Index: Integer): Boolean;  
  126. begin  
  127.   Result := not PRemoteConnection(AOwnerList[Index]).InUse;  
  128.   if Result then  
  129.     PRemoteConnection(AOwnerList[Index]).InUse := True;  
  130. end;  
  131.    
  132. function TADOConnectionPool.LockConnection: TADOConnection;  
  133. var  
  134.   i,WaitResult: Integer;  
  135.   ConnList:TList;  
  136. begin  
  137.   Result := nil;  
  138.   WaitResult:= WaitForSingleObject(FSemaphore, Timeout);  
  139.   if WaitResult = WAIT_FAILED then  
  140.     raise Exception.Create('Server busy, please try again');  
  141.    
  142.   ConnList:=FConnectionList.LockList;  
  143.   try  
  144.     try  
  145.       for i := 0 to ConnList.Count - 1 do  
  146.       begin  
  147.         if GetLock(ConnList,i) then  
  148.         begin  
  149.           Result := PRemoteConnection(ConnList[i]).Connection;  
  150.           Exit;  
  151.         end;  
  152.       end;  
  153.       if ConnList.Count < MaxCount then  
  154.         Result := CreateNewInstance(ConnList);  
  155.     except  
  156.       // 获取信号且失败则释放一个信号量  
  157.       if WaitResult=WAIT_OBJECT_0 then  
  158.         ReleaseSemaphore(FSemaphore, 1, nil);  
  159.       raise;  
  160.     end;  
  161.   finally  
  162.     FConnectionList.UnlockList;  
  163.   end;  
  164.    
  165.   if Result = nil then  
  166.   begin  
  167.     if WaitResult=WAIT_TIMEOUT then  
  168.       raise Exception.Create('Timeout expired.Connection pool is full.')  
  169.     else  
  170.       { This   shouldn 't   happen   because   of   the   sempahore   locks }  
  171.       raise Exception.Create('Unable to lock Connection');  
  172.   end;  
  173. end;  
  174.    
  175. procedure TADOConnectionPool.UnlockConnection(var Value: TADOConnection);  
  176. var  
  177.   i: Integer;  
  178.   ConnList:TList;  
  179. begin  
  180.   ConnList:=FConnectionList.LockList;  
  181.   try  
  182.     for i := 0 to ConnList.Count - 1 do  
  183.     begin  
  184.       if Value = PRemoteConnection(ConnList[i]).Connection then  
  185.       begin  
  186.         PRemoteConnection(ConnList[I]).InUse := False;  
  187.         ReleaseSemaphore(FSemaphore, 1, nil);  
  188.    
  189.         break;  
  190.       end;  
  191.     end;  
  192.   finally  
  193.     FConnectionList.UnlockList;  
  194.   end;  
  195. end;  
  196.    
  197. initialization  
  198.    
  199. ConnectionPool := TADOConnectionPool.Create();  
  200.    
  201. finalization  
  202.    
  203. ConnectionPool.Free;  
  204.    
  205. end.  


 

3.

[delphi] view plain copy
 
 print?在CODE上查看代码片派生到我的代码片
  1. 当连接数多，使用频繁时，用连接池大大提高效率  
  2.   
  3. unit uDBPool;  
  4.   
  5. interface  
  6.   
  7. uses Classes ,ADODB,ADOInt,Messages,SysUtils,DataDefine,Windows , Forms,  
  8.     Dialogs;  
  9.   
  10. type  
  11.    TDBPool = class  
  12.    private  
  13.      FList :TList;  
  14.      FbLoad :Boolean;  
  15.      FsConnStr :String;  
  16.      FbResetConnect: Boolean;  //是否准备复位所有的连接     
  17.   
  18.      CS_GetConn: TRTLCriticalSection;  
  19.      FConnStatus: Boolean;// ADOConnection 连接状态  
  20.      procedure Clear;  
  21.      procedure Load;  
  22.    protected  
  23.      procedure ConRollbackTransComplete(  
  24.                 Connection: TADOConnection; const Error: ADOInt.Error;  
  25.                 var EventStatus: TEventStatus);  
  26.      procedure ConCommitTransComplete(  
  27.                 Connection: TADOConnection; const Error: ADOInt.Error;  
  28.                 var EventStatus: TEventStatus);  
  29.      procedure ConBeginTransComplete(  
  30.                 Connection: TADOConnection; TransactionLevel: Integer;  
  31.                 const Error: ADOInt.Error; var EventStatus: TEventStatus);  
  32.    public  
  33.      constructor Create(ConnStr :string);  
  34.      destructor Destroy; override;  
  35.      procedure Reset;  
  36.      function GetConnection: PRecConnection;  
  37.      procedure AddConnetion ;  // GetConnection繁忙遍历多次时，添加新连接  
  38.      procedure FreeIdleConnetion ; // 销毁闲着的链接  
  39.      procedure RemoveConnection(ARecConnetion: PRecConnection);    
  40.      procedure CloseConnection;   //关闭所有连接    
  41.      property bConnStauts : Boolean read FConnStatus write FConnStatus default True;  
  42.    end;  
  43.   
  44. var  
  45.   DataBasePool : TDBPool;   
  46.   
  47. implementation  
  48.   
  49. { TDBPool }  
  50.   
  51. procedure TDBPool.ConRollbackTransComplete(  
  52.   Connection: TADOConnection; const Error: ADOInt.Error;  
  53.   var EventStatus: TEventStatus);  
  54. begin  
  55.   Now_SWcount := Now_SWcount-1;  
  56. end;  
  57.   
  58. procedure TDBPool.ConCommitTransComplete(  
  59.   Connection: TADOConnection; const Error: ADOInt.Error;  
  60.   var EventStatus: TEventStatus);  
  61. begin  
  62.   Now_SWcount := Now_SWcount-1;  
  63. end;  
  64.   
  65. procedure TDBPool.ConBeginTransComplete(  
  66.   Connection: TADOConnection; TransactionLevel: Integer;  
  67.   const Error: ADOInt.Error; var EventStatus: TEventStatus);  
  68. begin  
  69.   Now_SWcount := Now_SWcount+1;  
  70. end;  
  71.   
  72. constructor TDBPool.Create(ConnStr: string);  
  73. begin  
  74.   inherited Create;  
  75.   InitializeCriticalSection(CS_GetConn); //初始临界区对象。  
  76.   FbResetConnect := False;  
  77.   FList  := TList.Create;  
  78.   FbLoad := False;  
  79.   FsConnStr := ConnStr;  
  80.   Load;  
  81. end;  
  82.   
  83. destructor TDBPool.Destroy;  
  84. begin  
  85.   Clear;  
  86.   FList.Free;  
  87.   DeleteCriticalSection(CS_GetConn);  
  88.   inherited;  
  89. end;  
  90.   
  91. procedure TDBPool.Clear;  
  92. var  
  93.   i:Integer;  
  94.   tmpRecConn :PRecConnection;  
  95. begin  
  96.   for i:= 0 to FList.Count-1 do  
  97.   begin  
  98.     tmpRecConn := FList.items[i];  
  99.     tmpRecConn^.ADOConnection.Close;  
  100.     tmpRecConn^.ADOConnection.Free;  
  101.     Dispose(tmpRecConn);  
  102.     FList.Items[i] := nil;  
  103.   end;  
  104.   FList.Pack;  
  105.   FList.Clear;  
  106. end;  
  107.   
  108. procedure TDBPool.Load;  
  109. var  
  110.   i :Integer;  
  111.   tmpRecConn :PRecConnection;  
  112.   AdoConn :TADOConnection;  
  113. begin  
  114.   if FbLoad then Exit;  
  115.   Clear;  
  116.   for i:=1 to iConnCount do  
  117.   begin  
  118.     AdoConn := TADOConnection.Create(nil);  
  119.     AdoConn.ConnectionString:= FsConnStr;  
  120.     AdoConn.OnRollbackTransComplete := ConRollbackTransComplete;  
  121.     AdoConn.OnCommitTransComplete   := ConCommitTransComplete;  
  122.     AdoConn.OnBeginTransComplete    := ConBeginTransComplete;  
  123. //    AdoConn.Open;  
  124.     AdoConn.LoginPrompt := False;  
  125.     New(tmpRecConn);  
  126.     tmpRecConn^.ADOConnection := AdoConn;  
  127.     tmpRecConn^.isBusy := False;  
  128.     FList.Add(tmpRecConn);  
  129.     FConnStatus := True;  
  130.   end;  
  131. end;  
  132.   
  133. procedure TDBPool.Reset;  
  134. begin  
  135.   FbLoad := False;  
  136.   Load;  
  137. end;  
  138.   
  139. function TDBPool.GetConnection: PRecConnection;  
  140. var  
  141.   i :Integer;  
  142.   tmpRecConnection :PRecConnection;  
  143.   bFind :Boolean ;  
  144. begin  
  145.   Result := nil;  
  146.   //                   1、加互斥对象，防止多客户端同时访问  
  147.   //                   2、改为循环获取连接，知道获取到为止  
  148.   //                   3、加判断ADOConnection 没链接是才打开  
  149.   
  150.   EnterCriticalSection(CS_GetConn);  
  151.   bFind :=False ;  
  152.   try  
  153.     try  
  154.       //iFindFount :=0 ;  
  155.     while (not bFind) and (not FbResetConnect) do  
  156.       begin  
  157. //        if not FConnStatus then     //当测试断线的时候可能ADOConnection的状态不一定为False  
  158. //          Reset;  
  159.         for i:= 0 to FList.Count-1 do  
  160.         begin  
  161.           //PRecConnection(FList.Items[i])^.ADOConnection.Close ;  
  162.           tmpRecConnection := FList.Items[i];  
  163.           if not tmpRecConnection^.isBusy then  
  164.           begin  
  165.             if not tmpRecConnection^.ADOConnection.Connected then   
  166.               tmpRecConnection^.ADOConnection.Open;  
  167.             tmpRecConnection^.isBusy := True;  
  168.             Result := tmpRecConnection;  
  169.             bFind :=True ;  
  170.             Break;  
  171.           end;  
  172.         end;  
  173.       application.ProcessMessages;  
  174.         Sleep(50) ;  
  175.        { Inc(iFindFount) ; 
  176.         if(iFindFount>=1) then 
  177.         begin       // 遍历5次还找不到空闲连接，则添加链接 
  178.           AddConnetion ; 
  179.         end;  }  
  180.       end ;  
  181.     except  
  182.       on e: Exception do  
  183.         raise Exception.Create('TDBPOOL.GetConnection-->' + e.Message);    
  184.     end;  
  185.   finally  
  186.     LeaveCriticalSection(CS_GetConn);  
  187.   end ;  
  188. end;  
  189.   
  190. procedure TDBPool.RemoveConnection(ARecConnetion: PRecConnection);  
  191. begin  
  192.   if ARecConnetion^.ADOConnection.InTransaction then  
  193.      ARecConnetion^.ADOConnection.CommitTrans;  
  194.   ARecConnetion^.isBusy := False;  
  195. end;  
  196.     
  197. procedure TDBPool.AddConnetion;  
  198. var  
  199.   i,uAddCount :Integer ;  
  200.   tmpRecConn :PRecConnection;  
  201.   AdoConn : TADOConnection ;  
  202. begin  
  203.   if  FList.Count >= iMaxConnCount  then  
  204.     Exit ;  
  205.   if iMaxConnCount - FList.Count > 10 then  
  206.   begin  
  207.     uAddCount :=10 ;  
  208.   end else  
  209.   begin  
  210.     uAddCount :=iMaxConnCount - FList.Count ;  
  211.   end;  
  212.   for i:=1 to uAddCount do  
  213.   begin  
  214.     AdoConn := TADOConnection.Create(nil);  
  215.     AdoConn.ConnectionString:= FsConnStr;  
  216.     AdoConn.OnRollbackTransComplete := ConRollbackTransComplete;  
  217.     AdoConn.OnCommitTransComplete   := ConCommitTransComplete;  
  218.     AdoConn.OnBeginTransComplete    := ConBeginTransComplete;  
  219. //    AdoConn.Open;  
  220.     AdoConn.LoginPrompt := False;  
  221.     New(tmpRecConn);  
  222.     tmpRecConn^.ADOConnection := AdoConn;  
  223.     tmpRecConn^.isBusy := False;  
  224.     FList.Add(tmpRecConn);  
  225.     Dispose(tmpRecConn) ;  
  226.   end;  
  227. end;  
  228.   
  229. procedure TDBPool.FreeIdleConnetion;  
  230. var  
  231.   i,uFreeCount,uMaxFreeCount :Integer ;  
  232.   tmpRecConn : PRecConnection ;  
  233. begin  
  234.   if FList.Count<=iConnCount then  
  235.     Exit ;  
  236.   uMaxFreeCount :=FList.Count- iConnCount ;  
  237.   uFreeCount :=0 ;  
  238.   for i:= 0 to FList.Count do  
  239.   begin  
  240.     if (uFreeCount>=uMaxFreeCount) then  
  241.       Break ;  
  242.    // New(tmpRecConn) ;  
  243.     tmpRecConn := FList.items[i];  
  244.     if tmpRecConn^.isBusy =False  then  
  245.     begin  
  246.       tmpRecConn^.ADOConnection.Close;  
  247.       tmpRecConn^.ADOConnection.Free;  
  248.       uFreeCount :=uFreeCount +1 ;  
  249.     end;  
  250.     Dispose(tmpRecConn);  
  251.     FList.Items[i] := nil;  
  252.   end;  
  253.   FList.Pack;  
  254. end;   
  255.     
  256. procedure TDBPool.CloseConnection;  
  257. begin  
  258.   FbResetConnect := True;  
  259.   EnterCriticalSection(CS_GetConn);  
  260.   try  
  261.     Reset;  
  262.   finally  
  263.     LeaveCriticalSection(CS_GetConn);  
  264.     FbResetConnect := False;  
  265.   end;  
  266. end;  
  267.   
  268. end.  


 http://blog.csdn.net/aroc_lo/article/details/22299303

【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/findumars/p/5400230.html