ADOConnection数据库连接池

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

2.

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

3.

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

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