以下是完整的Delphi数据库连接池实现代码，包含初始化、连接获取和使用示例：
1. 连接池初始化单元 (uDBPool.pas)
unit uDBPool;interfaceusesFireDAC.Comp.Client, FireDAC.Stan.Def;procedure InitConnectionPool;
function GetConnectionFromPool: TFDConnection;
procedure ReleaseConnection(var AConnection: TFDConnection);implementationusesFireDAC.Phys.MSSQL;procedure InitConnectionPool;
beginFDManager.Close;FDManager.ConnectionDefs.Clear;FDManager.AddConnectionDef('MSSQL_Pool', 'MSSQL','DriverID=MSSQL;' +'Server=192.168.1.100,1433;' +'Database=MyDB;' +'User_Name=sa;' +'Password=123456;' +'Pooled=True;' +'POOL_MaxSize=20;' +'POOL_ExpireTimeout=30000;' +'LoginTimeout=3;' +'Mars=Yes');FDManager.Active := True;
end;function GetConnectionFromPool: TFDConnection;
beginResult := TFDConnection.Create(nil);tryResult.ConnectionDefName := 'MSSQL_Pool';Result.LoginPrompt := False;Result.ResourceOptions.AutoReconnect := True;Result.FetchOptions.Mode := fmAutomatic;Result.FetchOptions.AutoClose := True;Result.Open;exceptFreeAndNil(Result);raise;end;
end;procedure ReleaseConnection(var AConnection: TFDConnection);
beginif Assigned(AConnection) thenbeginif AConnection.Connected thenAConnection.Close;FreeAndNil(AConnection);end;
end;end.
2. 使用示例单元 (uMainForm.pas)
unit uMainForm;interfaceusesWinapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,FireDAC.Comp.Client, Vcl.StdCtrls;typeTfrmMain = class(TForm)btnQuery: TButton;procedure FormCreate(Sender: TObject);procedure btnQueryClick(Sender: TObject);procedure FormDestroy(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varfrmMain: TfrmMain;implementation{$R *.dfm}uses uDBPool;procedure TfrmMain.FormCreate(Sender: TObject);
beginInitConnectionPool;
end;procedure TfrmMain.btnQueryClick(Sender: TObject);
varConn: TFDConnection;Query: TFDQuery;
beginConn := GetConnectionFromPool;tryQuery := TFDQuery.Create(nil);tryQuery.Connection := Conn;Query.SQL.Text := 'SELECT TOP 10 * FROM Customers';Query.Open;while not Query.Eof dobeginShowMessage(Query.FieldByName('CompanyName').AsString);Query.Next;end;finallyQuery.Free;end;finallyReleaseConnection(Conn);end;
end;procedure TfrmMain.FormDestroy(Sender: TObject);
beginFDManager.Close;
end;end.
3. 直接连接版本 (非池化)
unit uDirectDB;interfacefunction GetDirectConnection: TFDConnection;
procedure ReleaseDirectConnection(var AConnection: TFDConnection);implementationfunction GetDirectConnection: TFDConnection;
beginResult := TFDConnection.Create(nil);trywith Result.Params dobeginAdd('DriverID=MSSQL');Add('Server=192.168.1.100,1433');Add('Database=MyDB');Add('User_Name=sa');Add('Password=123456');Add('Pooled=False');Add('LoginTimeout=3');end;Result.LoginPrompt := False;Result.Open;exceptFreeAndNil(Result);raise;end;
end;procedure ReleaseDirectConnection(var AConnection: TFDConnection);
beginif Assigned(AConnection) thenbeginif AConnection.Connected thenAConnection.Close;FreeAndNil(AConnection);end;
end;end.
4. 项目文件 (Project1.dpr)
program Project1;usesVcl.Forms,uMainForm in 'uMainForm.pas' {frmMain},uDBPool in 'uDBPool.pas',uDirectDB in 'uDirectDB.pas';{$R *.res}beginApplication.Initialize;Application.MainFormOnTaskbar := True;Application.CreateForm(TfrmMain, frmMain);Application.Run;
end.
关键功能说明
- 连接池管理：
- 自动维护连接生命周期
- 支持最大20个连接
- 30秒空闲超时
- 异常安全：
- 所有资源都有try-finally保护
- 连接失败时自动释放资源
- 使用建议：
- 主窗体创建时初始化连接池
- 每次查询获取新连接
- 操作完成后立即释放
- 性能优化：
- 启用MARS(多活动结果集)
- 自动重连机制
- 智能数据获取模式
这套实现可以直接集成到现有Delphi项目中，只需修改连接字符串参数即可使用。
