├── .gitignore ├── Core ├── DBPoolConnection.Interfaces.pas ├── DBPoolConnection.Types.pas ├── DBPoolConnection.pas └── backup │ ├── DBPoolConnection.Interfaces.pas │ ├── DBPoolConnection.Types.pas │ └── DBPoolConnection.pas ├── README.md └── Test ├── TestDelphi.dpr ├── TestDelphi.dproj ├── TestDelphi.lpi ├── TestDelphi.lps ├── TestDelphi.res ├── TestDelphi.stat ├── uMain.dfm ├── uMain.lfm └── uMain.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /Core/DBPoolConnection.Interfaces.pas: -------------------------------------------------------------------------------- 1 | unit DBPoolConnection.Interfaces; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | Classes, 11 | DBPoolConnection.Types; 12 | 13 | type 14 | 15 | IDBConnection = interface 16 | ['{7BEE7CD3-7054-4080-B4A8-B021F2392A0D}'] 17 | function GetDatabaseComponent: TObject; 18 | property DatabaseComponent: TObject read GetDatabaseComponent; 19 | end; 20 | 21 | IDBPoolConnection = interface 22 | ['{BB99A3F8-ACC7-43A5-A9C4-F01799A5BAF2}'] 23 | function SetMaxPool(AMaxPool: Integer): IDBPoolConnection; 24 | function SetCleanUpTimeout(ACleanUpTimeout: Integer): IDBPoolConnection; 25 | function SetOnCreateDatabaseComponent(AValue: TCreateDatabaseComponentEvent): IDBPoolConnection; 26 | function WaintAvailableConnection(AValue: Boolean): IDBPoolConnection; 27 | function GetDBConnection: IDBConnection; overload; 28 | function GetDBConnection(ATenantDatabase: string): IDBConnection; overload; 29 | function GetStatus: string; 30 | end; 31 | 32 | implementation 33 | 34 | end. 35 | -------------------------------------------------------------------------------- /Core/DBPoolConnection.Types.pas: -------------------------------------------------------------------------------- 1 | unit DBPoolConnection.Types; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | 8 | interface 9 | 10 | uses Classes; 11 | 12 | type 13 | 14 | TCreateDatabaseComponentEvent = {$IFNDEF FPC}reference to {$ENDIF}function(ATenantDatabase: string): TObject; 15 | 16 | implementation 17 | 18 | end. 19 | -------------------------------------------------------------------------------- /Core/DBPoolConnection.pas: -------------------------------------------------------------------------------- 1 | unit DBPoolConnection; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | Classes, 11 | SysUtils, 12 | SyncObjs, 13 | Generics.Collections, 14 | DBPoolConnection.Interfaces, 15 | DBPoolConnection.Types; 16 | 17 | type 18 | 19 | EDBPoolConnectionException = class(Exception); 20 | 21 | TDBConnectionItem = class 22 | private 23 | FLocked: Boolean; 24 | FLastUse: TDateTime; 25 | FDatabaseComponent: TObject; 26 | public 27 | property Locked: Boolean read FLocked write FLocked; 28 | property LastUse: TDateTime read FLastUse write FLastUse; 29 | property DatabaseComponent: TObject read FDatabaseComponent write FDatabaseComponent;//Zeos,UniDac,etc 30 | end; 31 | 32 | TDBConnection = class(TInterfacedObject, IDBConnection) 33 | private 34 | FDatabaseComponent: TObject; 35 | FTenantDatabase: string; 36 | function GetDatabaseComponent: TObject; 37 | procedure UnlockConnection; 38 | public 39 | constructor Create(ATenantDatabase: string; ADatabaseComponent: TObject); 40 | destructor Destroy; override; 41 | class function New(ATenantDatabase: string; ADatabaseComponent: TObject): IDBConnection; 42 | end; 43 | 44 | { TDBPoolConnection } 45 | 46 | TDBPoolConnection = class(TInterfacedObject, IDBPoolConnection) 47 | private 48 | FMaxPool: Integer; 49 | FCleanUpTimeout: Integer; 50 | FWaitAvailableConnection: Boolean; 51 | FOnCreateDatabaseComponent: TCreateDatabaseComponentEvent; 52 | function GetAvailableConnection(ATenantDatabse: string; AConnectionList: TThreadList): IDBConnection; 53 | function HaveDuplicatedConnection(ADatabaseComponent: TObject): Boolean; 54 | procedure FreePool; 55 | procedure CleanUpConnections(AList: TList); 56 | constructor CreatePrivate; 57 | public 58 | constructor Create; 59 | destructor Destroy; override; 60 | class function GetInstance: IDBPoolConnection; 61 | function SetMaxPool(AMaxPool: Integer): IDBPoolConnection; 62 | function SetCleanUpTimeout(ACleanUpTimeout: Integer): IDBPoolConnection; 63 | function SetOnCreateDatabaseComponent(AValue: TCreateDatabaseComponentEvent): IDBPoolConnection; 64 | function WaintAvailableConnection(AValue: Boolean): IDBPoolConnection; 65 | function GetDBConnection: IDBConnection; overload; 66 | function GetDBConnection(ATenantDatabase: string): IDBConnection; overload; 67 | function GetStatus: string; 68 | end; 69 | 70 | implementation 71 | 72 | uses 73 | StrUtils, 74 | DateUtils; 75 | 76 | var 77 | FDBPoolSingleton: IDBPoolConnection; 78 | FPool: TDictionary>; 79 | FLockPool: TCriticalSection; 80 | 81 | { TDBPoolConnection } 82 | 83 | function TDBPoolConnection.GetDBConnection: IDBConnection; 84 | begin 85 | Result := Self.GetDBConnection('default'); 86 | end; 87 | 88 | function TDBPoolConnection.HaveDuplicatedConnection( 89 | ADatabaseComponent: TObject): Boolean; 90 | var 91 | vTenantDatabase: string; 92 | vConnectionList: TThreadList; 93 | vList: TList; 94 | i, vCount: Integer; 95 | begin 96 | vCount := 0; 97 | for vTenantDatabase in FPool.Keys do 98 | begin 99 | if FPool.TryGetValue(vTenantDatabase, vConnectionList) then 100 | begin 101 | try 102 | vList := vConnectionList.LockList; 103 | for i := 0 to vList.Count-1 do 104 | begin 105 | if vList.Items[i].DatabaseComponent = ADatabaseComponent then 106 | Inc(vCount); 107 | end; 108 | finally 109 | vConnectionList.UnlockList; 110 | end; 111 | end; 112 | end; 113 | Result := vCount > 1; 114 | end; 115 | 116 | procedure TDBPoolConnection.CleanUpConnections(AList: TList); 117 | var 118 | i: Integer; 119 | vItem: TDBConnectionItem; 120 | vNow: TDateTime; 121 | begin 122 | if FCleanUpTimeout = 0 then Exit; 123 | vNow := Now; 124 | 125 | for i:= AList.Count -1 downto 0 do 126 | begin 127 | vItem := AList.Items[i]; 128 | if (not vItem.Locked) and 129 | (MilliSecondsBetween(vNow, vItem.LastUse) >= FCleanUpTimeout) then 130 | begin 131 | vItem.DatabaseComponent.Free; 132 | vItem.Free; 133 | AList.Delete(i); 134 | end; 135 | end; 136 | end; 137 | 138 | constructor TDBPoolConnection.Create; 139 | begin 140 | raise EDBPoolConnectionException.Create('Use TDBPoolConnection.GetInstance'); 141 | end; 142 | 143 | constructor TDBPoolConnection.CreatePrivate; 144 | begin 145 | inherited Create; 146 | FPool := TDictionary>.Create; 147 | FLockPool := TCriticalSection.Create; 148 | FMaxPool:= 10; 149 | FCleanUpTimeout := 0; 150 | FWaitAvailableConnection := True; 151 | end; 152 | 153 | destructor TDBPoolConnection.Destroy; 154 | begin 155 | FreePool; 156 | FLockPool.Free; 157 | inherited; 158 | end; 159 | 160 | procedure TDBPoolConnection.FreePool; 161 | var 162 | i: Integer; 163 | vTenantDatabase: string; 164 | vConnectionList: TThreadList; 165 | vList: TList; 166 | begin 167 | //free List Connections and Database Connections 168 | for vTenantDatabase in FPool.Keys do 169 | begin 170 | if FPool.TryGetValue(vTenantDatabase, vConnectionList) then 171 | begin 172 | try 173 | vList := vConnectionList.LockList; 174 | for i := 0 to vList.Count-1 do 175 | begin 176 | vList.Items[i].DatabaseComponent.Free; 177 | vList.Items[i].Free; 178 | end; 179 | vList.Clear; 180 | finally 181 | vConnectionList.UnlockList; 182 | vConnectionList.Clear; 183 | vConnectionList.Free; 184 | end; 185 | end; 186 | end; 187 | FPool.Clear; 188 | FPool.Free; 189 | end; 190 | 191 | function TDBPoolConnection.GetAvailableConnection(ATenantDatabse: string; 192 | AConnectionList: TThreadList): IDBConnection; 193 | var 194 | vList: TList; 195 | vItem: TDBConnectionItem; 196 | vDatabaseComponent: TObject; 197 | i: Integer; 198 | begin 199 | Result := nil; 200 | 201 | while (Result = nil) do 202 | begin 203 | try 204 | vList := AConnectionList.LockList; 205 | CleanUpConnections(vList); 206 | //search for available connection in Pool 207 | for i:= 0 to vList.Count -1 do 208 | begin 209 | vItem := vList.Items[i]; 210 | if not vItem.Locked then 211 | begin 212 | vItem.Locked := True; 213 | vItem.LastUse := Now; 214 | Result := TDBConnection.New(ATenantDatabse, vItem.DatabaseComponent); 215 | Break; 216 | end; 217 | end; 218 | if (Result = nil) and (vList.Count < FMaxPool) then 219 | begin 220 | //create new connection database 221 | vDatabaseComponent := FOnCreateDatabaseComponent(ATenantDatabse); 222 | vItem := TDBConnectionItem.Create; 223 | vItem.DatabaseComponent := vDatabaseComponent; 224 | vItem.Locked := True; 225 | vItem.LastUse := Now; 226 | vList.Add(vItem); 227 | Result := TDBConnection.New(ATenantDatabse, vItem.DatabaseComponent); 228 | end; 229 | finally 230 | AConnectionList.UnlockList; 231 | end; 232 | 233 | if (Result = nil) and (not FWaitAvailableConnection) then 234 | Break 235 | else if Result = nil then 236 | Sleep(100);//wait few milliseconds and try again 237 | end; 238 | end; 239 | 240 | function TDBPoolConnection.GetDBConnection( 241 | ATenantDatabase: string): IDBConnection; 242 | var 243 | vList: TThreadList; 244 | begin 245 | Result := nil; 246 | 247 | if ATenantDatabase = '' then 248 | raise EDBPoolConnectionException.Create('Undefined TenantDatabase'); 249 | if not Assigned(FOnCreateDatabaseComponent) then 250 | raise EDBPoolConnectionException.Create('Undefined OnCreateDatabaseComponent event'); 251 | 252 | try 253 | FLockPool.Enter; 254 | if FPool.TryGetValue(ATenantDatabase, vList) then 255 | Result := GetAvailableConnection(ATenantDatabase, vList) 256 | else 257 | begin 258 | vList := TThreadList.Create; 259 | FPool.Add(ATenantDatabase, vList); 260 | Result := GetAvailableConnection(ATenantDatabase, vList); 261 | end; 262 | finally 263 | FLockPool.Leave; 264 | end; 265 | end; 266 | 267 | class function TDBPoolConnection.GetInstance: IDBPoolConnection; 268 | begin 269 | if FDBPoolSingleton = nil then 270 | FDBPoolSingleton := TDBPoolConnection.CreatePrivate; 271 | 272 | Result := FDBPoolSingleton; 273 | end; 274 | 275 | function TDBPoolConnection.GetStatus: string; 276 | var 277 | vTenantDatabase, vStatus: string; 278 | vConnectionList: TThreadList; 279 | vList: TList; 280 | i, vAvailable, vLocked, vDuplicated: Integer; 281 | begin 282 | vStatus := ''; 283 | vDuplicated := 0; 284 | try 285 | FLockPool.Enter; 286 | for vTenantDatabase in FPool.Keys do 287 | begin 288 | if FPool.TryGetValue(vTenantDatabase, vConnectionList) then 289 | begin 290 | try 291 | vAvailable := 0; 292 | vLocked := 0; 293 | vList := vConnectionList.LockList; 294 | for i := 0 to vList.Count-1 do 295 | begin 296 | if TDBConnectionItem(vList.Items[i]).Locked then 297 | Inc(vLocked) 298 | else 299 | Inc(vAvailable); 300 | if HaveDuplicatedConnection(TDBConnectionItem(vList.Items[i]).DatabaseComponent) then 301 | Inc(vDuplicated); 302 | end; 303 | vStatus := vStatus + Format('TenantDatabase: %s Total: %d Locked: %d Available: %d', 304 | [vTenantDatabase, vList.Count, vLocked, vAvailable]) + sLineBreak; 305 | finally 306 | vConnectionList.UnlockList; 307 | end; 308 | end; 309 | end; 310 | finally 311 | FLockPool.Leave; 312 | end; 313 | vStatus := vStatus + 'Duplicated Connections: '+IntToStr(vDuplicated)+ 314 | IfThen(vDuplicated=0, ' ITs OK', ' THIS IS NOT GOOD'); 315 | Result := vStatus; 316 | end; 317 | 318 | function TDBPoolConnection.SetCleanUpTimeout( 319 | ACleanUpTimeout: Integer): IDBPoolConnection; 320 | begin 321 | Result := Self; 322 | FCleanUpTimeout := ACleanUpTimeout; 323 | end; 324 | 325 | function TDBPoolConnection.SetMaxPool(AMaxPool: Integer): IDBPoolConnection; 326 | begin 327 | Result := Self; 328 | FMaxPool := AMaxPool; 329 | end; 330 | 331 | function TDBPoolConnection.SetOnCreateDatabaseComponent( 332 | AValue: TCreateDatabaseComponentEvent): IDBPoolConnection; 333 | begin 334 | Result := Self; 335 | FOnCreateDatabaseComponent := AValue; 336 | end; 337 | 338 | function TDBPoolConnection.WaintAvailableConnection(AValue: Boolean 339 | ): IDBPoolConnection; 340 | begin 341 | Result := Self; 342 | FWaitAvailableConnection := AValue; 343 | end; 344 | 345 | { TDBConnection } 346 | 347 | constructor TDBConnection.Create(ATenantDatabase: string; ADatabaseComponent: TObject); 348 | begin 349 | inherited Create; 350 | FDatabaseComponent := ADatabaseComponent; 351 | FTenantDatabase := ATenantDatabase; 352 | end; 353 | 354 | destructor TDBConnection.Destroy; 355 | begin 356 | UnlockConnection; 357 | inherited; 358 | end; 359 | 360 | function TDBConnection.GetDatabaseComponent: TObject; 361 | begin 362 | Result := FDatabaseComponent; 363 | end; 364 | 365 | class function TDBConnection.New(ATenantDatabase: string; ADatabaseComponent: TObject): IDBConnection; 366 | begin 367 | Result := TDBConnection.Create(ATenantDatabase, ADatabaseComponent); 368 | end; 369 | 370 | procedure TDBConnection.UnlockConnection; 371 | var 372 | vConnectionList: TThreadList; 373 | vList: TList; 374 | vItem: TDBConnectionItem; 375 | vFound: Boolean; 376 | i: Integer; 377 | begin 378 | vConnectionList := nil; 379 | vFound := False; 380 | if FPool.TryGetValue(FTenantDatabase, vConnectionList) then 381 | begin 382 | try 383 | vList := vConnectionList.LockList; 384 | for i:= 0 to vList.Count-1 do 385 | begin 386 | vItem := vList.Items[i]; 387 | if vItem.DatabaseComponent = FDatabaseComponent then 388 | begin 389 | vItem.Locked := False; 390 | vFound := True; 391 | Break; 392 | end; 393 | end; 394 | finally 395 | vConnectionList.UnlockList; 396 | end; 397 | end; 398 | Assert(vConnectionList<>nil, 'TenantDatabase not found'); 399 | Assert(vFound, 'DatabaseComponent not found in List'); 400 | end; 401 | 402 | initialization 403 | FDBPoolSingleton := nil; 404 | FLockPool := nil; 405 | 406 | end. 407 | -------------------------------------------------------------------------------- /Core/backup/DBPoolConnection.Interfaces.pas: -------------------------------------------------------------------------------- 1 | unit DBPoolConnection.Interfaces; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | Classes, 11 | DBPoolConnection.Types; 12 | 13 | type 14 | 15 | IDBConnection = interface 16 | ['{7BEE7CD3-7054-4080-B4A8-B021F2392A0D}'] 17 | function GetDatabaseComponent: TObject; 18 | property DatabaseComponent: TComponent read GetDatabaseComponent; 19 | end; 20 | 21 | IDBPoolConnection = interface 22 | ['{BB99A3F8-ACC7-43A5-A9C4-F01799A5BAF2}'] 23 | function SetMaxPool(AMaxPool: Integer): IDBPoolConnection; 24 | function SetOnCreateDatabaseComponent(AValue: TCreateDatabaseComponentEvent): IDBPoolConnection; 25 | function WaintAvailableConnection(AValue: Boolean): IDBPoolConnection; 26 | function GetDBConnection: IDBConnection; overload; 27 | function GetDBConnection(ATenantDatabase: string): IDBConnection; overload; 28 | function GetStatus: string; 29 | end; 30 | 31 | implementation 32 | 33 | end. 34 | -------------------------------------------------------------------------------- /Core/backup/DBPoolConnection.Types.pas: -------------------------------------------------------------------------------- 1 | unit DBPoolConnection.Types; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | 8 | interface 9 | 10 | uses Classes; 11 | 12 | type 13 | 14 | TCreateDatabaseComponentEvent = {$IFNDEF FPC}reference to {$ENDIF}function(ATenantDatabase: string): TComponent; 15 | 16 | implementation 17 | 18 | end. 19 | -------------------------------------------------------------------------------- /Core/backup/DBPoolConnection.pas: -------------------------------------------------------------------------------- 1 | unit DBPoolConnection; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | Classes, 11 | SysUtils, 12 | SyncObjs, 13 | Generics.Collections, 14 | DBPoolConnection.Interfaces, 15 | DBPoolConnection.Types; 16 | 17 | type 18 | 19 | EDBPoolConnectionException = class(Exception); 20 | 21 | TDBConnectionItem = class 22 | private 23 | FLocked: Boolean; 24 | FLastUse: TDate; 25 | FDatabaseComponent: TComponent; 26 | public 27 | property Locked: Boolean read FLocked write FLocked; 28 | property LastUse: TDate read FLastUse write FLastUse; 29 | property DatabaseComponent: TComponent read FDatabaseComponent write FDatabaseComponent;//Zeos,UniDac,etc 30 | end; 31 | 32 | TDBConnection = class(TInterfacedObject, IDBConnection) 33 | private 34 | FDatabaseComponent: TComponent; 35 | FTenantDatabase: string; 36 | function GetDatabaseComponent: TComponent; 37 | procedure UnlockConnection; 38 | public 39 | constructor Create(ATenantDatabase: string; ADatabaseComponent: TComponent); 40 | destructor Destroy; override; 41 | class function New(ATenantDatabase: string; ADatabaseComponent: TComponent): IDBConnection; 42 | end; 43 | 44 | { TDBPoolConnection } 45 | 46 | TDBPoolConnection = class(TInterfacedObject, IDBPoolConnection) 47 | private 48 | FMaxPool: Integer; 49 | FWaitAvailableConnection: Boolean; 50 | FOnCreateDatabaseComponent: TCreateDatabaseComponentEvent; 51 | function GetAvailableConnection(ATenantDatabse: string; AConnectionList: TThreadList): IDBConnection; 52 | function HaveDuplicatedConnection(ADatabaseComponent: TComponent): Boolean; 53 | procedure FreePool; 54 | constructor CreatePrivate; 55 | public 56 | constructor Create; 57 | destructor Destroy; override; 58 | class function GetInstance: IDBPoolConnection; 59 | function SetMaxPool(AMaxPool: Integer): IDBPoolConnection; 60 | function SetOnCreateDatabaseComponent(AValue: TCreateDatabaseComponentEvent): IDBPoolConnection; 61 | function WaintAvailableConnection(AValue: Boolean): IDBPoolConnection; 62 | function GetDBConnection: IDBConnection; overload; 63 | function GetDBConnection(ATenantDatabase: string): IDBConnection; overload; 64 | function GetStatus: string; 65 | end; 66 | 67 | implementation 68 | 69 | uses 70 | StrUtils; 71 | 72 | var 73 | FDBPoolSingleton: IDBPoolConnection; 74 | FPool: TDictionary>; 75 | FLockPool: TCriticalSection; 76 | 77 | { TDBPoolConnection } 78 | 79 | function TDBPoolConnection.GetDBConnection: IDBConnection; 80 | begin 81 | Result := Self.GetDBConnection('default'); 82 | end; 83 | 84 | function TDBPoolConnection.HaveDuplicatedConnection( 85 | ADatabaseComponent: TComponent): Boolean; 86 | var 87 | vTenantDatabase: string; 88 | vConnectionList: TThreadList; 89 | vList: TList; 90 | i, vCount: Integer; 91 | begin 92 | vCount := 0; 93 | for vTenantDatabase in FPool.Keys do 94 | begin 95 | if FPool.TryGetValue(vTenantDatabase, vConnectionList) then 96 | begin 97 | try 98 | vList := vConnectionList.LockList; 99 | for i := 0 to vList.Count-1 do 100 | begin 101 | if vList.Items[i].DatabaseComponent = ADatabaseComponent then 102 | Inc(vCount); 103 | end; 104 | finally 105 | vConnectionList.UnlockList; 106 | end; 107 | end; 108 | end; 109 | Result := vCount > 1; 110 | end; 111 | 112 | constructor TDBPoolConnection.Create; 113 | begin 114 | raise EDBPoolConnectionException.Create('Use TDBPoolConnection.GetInstance'); 115 | end; 116 | 117 | constructor TDBPoolConnection.CreatePrivate; 118 | begin 119 | inherited Create; 120 | FPool := TDictionary>.Create; 121 | FLockPool := TCriticalSection.Create; 122 | FMaxPool:= 10; 123 | FWaitAvailableConnection := True; 124 | end; 125 | 126 | destructor TDBPoolConnection.Destroy; 127 | begin 128 | FreePool; 129 | FLockPool.Free; 130 | inherited; 131 | end; 132 | 133 | procedure TDBPoolConnection.FreePool; 134 | var 135 | i: Integer; 136 | vTenantDatabase: string; 137 | vConnectionList: TThreadList; 138 | vList: TList; 139 | begin 140 | //free List Connections and Database Connections 141 | for vTenantDatabase in FPool.Keys do 142 | begin 143 | if FPool.TryGetValue(vTenantDatabase, vConnectionList) then 144 | begin 145 | try 146 | vList := vConnectionList.LockList; 147 | for i := 0 to vList.Count-1 do 148 | begin 149 | vList.Items[i].DatabaseComponent.Free; 150 | vList.Items[i].Free; 151 | end; 152 | vList.Clear; 153 | finally 154 | vConnectionList.UnlockList; 155 | vConnectionList.Clear; 156 | vConnectionList.Free; 157 | end; 158 | end; 159 | end; 160 | FPool.Clear; 161 | FPool.Free; 162 | end; 163 | 164 | function TDBPoolConnection.GetAvailableConnection(ATenantDatabse: string; 165 | AConnectionList: TThreadList): IDBConnection; 166 | var 167 | vList: TList; 168 | vItem: TDBConnectionItem; 169 | vDatabaseComponent: TComponent; 170 | i: Integer; 171 | begin 172 | Result := nil; 173 | 174 | while (Result = nil) do 175 | begin 176 | try 177 | vList := AConnectionList.LockList; 178 | //search for available connection in Pool 179 | for i:= 0 to vList.Count -1 do 180 | begin 181 | vItem := vList.Items[i]; 182 | if not vItem.Locked then 183 | begin 184 | vItem.Locked := True; 185 | vItem.LastUse := Now; 186 | Result := TDBConnection.New(ATenantDatabse, vItem.DatabaseComponent); 187 | Break; 188 | end; 189 | end; 190 | if (Result = nil) and (vList.Count < FMaxPool) then 191 | begin 192 | //create new connection database 193 | vDatabaseComponent := FOnCreateDatabaseComponent(ATenantDatabse); 194 | vItem := TDBConnectionItem.Create; 195 | vItem.DatabaseComponent := vDatabaseComponent; 196 | vItem.Locked := True; 197 | vItem.LastUse := Now; 198 | vList.Add(vItem); 199 | Result := TDBConnection.New(ATenantDatabse, vItem.DatabaseComponent); 200 | end; 201 | finally 202 | AConnectionList.UnlockList; 203 | end; 204 | 205 | if (Result = nil) and (not FWaitAvailableConnection) then 206 | Break 207 | else if Result = nil then 208 | Sleep(100);//wait few milliseconds and try again 209 | end; 210 | end; 211 | 212 | function TDBPoolConnection.GetDBConnection( 213 | ATenantDatabase: string): IDBConnection; 214 | var 215 | vList: TThreadList; 216 | begin 217 | Result := nil; 218 | 219 | if ATenantDatabase = '' then 220 | raise EDBPoolConnectionException.Create('Undefined TenantDatabase'); 221 | if not Assigned(FOnCreateDatabaseComponent) then 222 | raise EDBPoolConnectionException.Create('Undefined OnCreateDatabaseComponent event'); 223 | 224 | try 225 | FLockPool.Enter; 226 | if FPool.TryGetValue(ATenantDatabase, vList) then 227 | Result := GetAvailableConnection(ATenantDatabase, vList) 228 | else 229 | begin 230 | vList := TThreadList.Create; 231 | FPool.Add(ATenantDatabase, vList); 232 | Result := GetAvailableConnection(ATenantDatabase, vList); 233 | end; 234 | finally 235 | FLockPool.Leave; 236 | end; 237 | end; 238 | 239 | class function TDBPoolConnection.GetInstance: IDBPoolConnection; 240 | begin 241 | if FDBPoolSingleton = nil then 242 | FDBPoolSingleton := TDBPoolConnection.CreatePrivate; 243 | 244 | Result := FDBPoolSingleton; 245 | end; 246 | 247 | function TDBPoolConnection.GetStatus: string; 248 | var 249 | vTenantDatabase, vStatus: string; 250 | vConnectionList: TThreadList; 251 | vList: TList; 252 | i, vAvailable, vLocked, vDuplicated: Integer; 253 | begin 254 | vStatus := ''; 255 | vDuplicated := 0; 256 | try 257 | FLockPool.Enter; 258 | for vTenantDatabase in FPool.Keys do 259 | begin 260 | if FPool.TryGetValue(vTenantDatabase, vConnectionList) then 261 | begin 262 | try 263 | vAvailable := 0; 264 | vLocked := 0; 265 | vList := vConnectionList.LockList; 266 | for i := 0 to vList.Count-1 do 267 | begin 268 | if TDBConnectionItem(vList.Items[i]).Locked then 269 | Inc(vLocked) 270 | else 271 | Inc(vAvailable); 272 | if HaveDuplicatedConnection(TDBConnectionItem(vList.Items[i]).DatabaseComponent) then 273 | Inc(vDuplicated); 274 | end; 275 | vStatus := vStatus + Format('TenantDatabase: %s Total: %d Locked: %d Available: %d', 276 | [vTenantDatabase, vList.Count, vLocked, vAvailable]) + sLineBreak; 277 | finally 278 | vConnectionList.UnlockList; 279 | end; 280 | end; 281 | end; 282 | finally 283 | FLockPool.Leave; 284 | end; 285 | vStatus := vStatus + 'Duplicated Connections: '+IntToStr(vDuplicated)+ 286 | IfThen(vDuplicated=0, ' ITs OK', ' THIS IS NOT GOOD'); 287 | Result := vStatus; 288 | end; 289 | 290 | function TDBPoolConnection.SetMaxPool(AMaxPool: Integer): IDBPoolConnection; 291 | begin 292 | Result := Self; 293 | FMaxPool := AMaxPool; 294 | end; 295 | 296 | function TDBPoolConnection.SetOnCreateDatabaseComponent( 297 | AValue: TCreateDatabaseComponentEvent): IDBPoolConnection; 298 | begin 299 | Result := Self; 300 | FOnCreateDatabaseComponent := AValue; 301 | end; 302 | 303 | function TDBPoolConnection.WaintAvailableConnection(AValue: Boolean 304 | ): IDBPoolConnection; 305 | begin 306 | Result := Self; 307 | FWaitAvailableConnection := AValue; 308 | end; 309 | 310 | { TDBConnection } 311 | 312 | constructor TDBConnection.Create(ATenantDatabase: string; ADatabaseComponent: TComponent); 313 | begin 314 | inherited Create; 315 | FDatabaseComponent := ADatabaseComponent; 316 | FTenantDatabase := ATenantDatabase; 317 | end; 318 | 319 | destructor TDBConnection.Destroy; 320 | begin 321 | UnlockConnection; 322 | inherited; 323 | end; 324 | 325 | function TDBConnection.GetDatabaseComponent: TComponent; 326 | begin 327 | Result := FDatabaseComponent; 328 | end; 329 | 330 | class function TDBConnection.New(ATenantDatabase: string; ADatabaseComponent: TComponent): IDBConnection; 331 | begin 332 | Result := TDBConnection.Create(ATenantDatabase, ADatabaseComponent); 333 | end; 334 | 335 | procedure TDBConnection.UnlockConnection; 336 | var 337 | vConnectionList: TThreadList; 338 | vList: TList; 339 | vItem: TDBConnectionItem; 340 | vFound: Boolean; 341 | i: Integer; 342 | begin 343 | vConnectionList := nil; 344 | vFound := False; 345 | if FPool.TryGetValue(FTenantDatabase, vConnectionList) then 346 | begin 347 | try 348 | vList := vConnectionList.LockList; 349 | for i:= 0 to vList.Count-1 do 350 | begin 351 | vItem := vList.Items[i]; 352 | if vItem.DatabaseComponent = FDatabaseComponent then 353 | begin 354 | vItem.Locked := False; 355 | vFound := True; 356 | Break; 357 | end; 358 | end; 359 | finally 360 | vConnectionList.UnlockList; 361 | end; 362 | end; 363 | Assert(vConnectionList<>nil, 'TenantDatabase not found'); 364 | Assert(vFound, 'DatabaseComponent not found in List'); 365 | end; 366 | 367 | initialization 368 | FDBPoolSingleton := nil; 369 | FLockPool := nil; 370 | 371 | end. 372 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # PascalDBPoolConnection 2 | Generic Database Connection Pooling for Delphi/Lazarus/FreePascal 3 | 4 | ## Why use a connection pool? 5 | Using connection pooling on application servers increases application performance. Avoiding connections at all times. 6 | 7 | ## Functionalities 8 | * Compatibility with Delphi XE7(Up) and Lazarus(Last version). 9 | * Simple and secure, just request connections to the pool. connections are returned to the pool automatically using reference counting. 10 | * Fully Thread-Safe, test project included to perform stress testing. 11 | * Works with any type of database access component because it does not use dependency on them (Zeos, Unidac, FireDac, etc.), the dependency is only with your application. 12 | * Multitenant Control. 13 | * Flexible to use with any development framework (Datasnap, Horse, RDW, etc). 14 | 15 | ## Initialize Pool 16 | ```pas 17 | {$IFDEF FPC} 18 | {$MODE Delphi} 19 | {$ENDIF} 20 | 21 | function NewDatabase(ATenantDatabase: string): TObject; 22 | var 23 | Conn: TZConnection; 24 | begin 25 | Conn := TZConnection.Create(nil); 26 | //..config your connection and open connection, check your TenantDatabse in Ini File for example 27 | //Conn.Open; 28 | //Sleep(100); //Uncomment this line to test with delay 29 | Result := Conn; 30 | end; 31 | 32 | procedure TFrmMain.FormCreate(Sender: TObject); 33 | begin 34 | FPool := TDBPoolConnection.GetInstance 35 | .SetMaxPool(100) 36 | .SetOnCreateDatabaseComponent(NewDatabase); 37 | end; 38 | ``` 39 | ## Get connection from pool 40 | ```pas 41 | var 42 | vDBConnection: IDBConnection; 43 | begin 44 | vDBConnection := FPool.GetDBConnection; 45 | if vDBConnection <> nil then 46 | begin 47 | //Using your connection 48 | //ZQuery.Connection := vDBConnection.DatabaseComponent as TZConnection; 49 | //ZQuery.SQL.Text := 'select * from dual'; 50 | //ZQuery.Open; 51 | end 52 | end; 53 | ``` 54 | -------------------------------------------------------------------------------- /Test/TestDelphi.dpr: -------------------------------------------------------------------------------- 1 | program TestDelphi; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | uses 8 | {$IFDEF FPC} 9 | Interfaces, 10 | {$ENDIF} 11 | Forms, 12 | uMain in 'uMain.pas' {FrmMain}, 13 | DBPoolConnection in '..\Core\DBPoolConnection.pas', 14 | DBPoolConnection.Interfaces in '..\Core\DBPoolConnection.Interfaces.pas', 15 | DBPoolConnection.Types in '..\Core\DBPoolConnection.Types.pas'; 16 | 17 | {$R *.res} 18 | 19 | begin 20 | Application.Initialize; 21 | {$IFNDEF FPC} 22 | ReportMemoryLeaksOnShutdown := True; 23 | Application.MainFormOnTaskbar := True; 24 | {$ENDIF} 25 | Application.CreateForm(TFrmMain, FrmMain); 26 | Application.Run; 27 | end. 28 | -------------------------------------------------------------------------------- /Test/TestDelphi.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {14D22BDF-4FC4-4898-92DF-7C377D3957AC} 4 | 17.2 5 | VCL 6 | TestDelphi.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 44 | TestDelphi 45 | $(BDS)\bin\delphi_PROJECTICON.ico 46 | .\$(Platform)\$(Config) 47 | .\$(Platform)\$(Config) 48 | false 49 | false 50 | false 51 | false 52 | false 53 | 54 | 55 | true 56 | 1033 57 | dxPScxSchedulerLnkRS21;cxSchedulerRibbonStyleEventEditorRS21;cxSchedulerRS21;rbTC2121;ViasoftVclDB_XE5;TMSScripter_Memo;FireDACPgDriver;vquery210;ACBr_GNRE;xdata;TMSLogging;GenericSocket;FixInsight_XE7;cxTreeListdxBarPopupMenuRS21;cxPivotGridRS21;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;ACBre_Social;ACBr_BlocoX;dxGaugeControlRS21;rbCIDE2121;cxEditorsRS21;SynEdit_R;DbxCommonDriver;vclimg;dxTileControlRS21;dxPSdxGaugeControlLnkRS21;dbxcds;dxPsPrVwAdvRS21;DatasnapConnectorsFreePascal;TMSScripter_Legacy;ACBr_Comum;ACBr_NF3e;vcldb;ViasoftUtilsGeral_XE5;rbFireDAC2121;cxTreeListRS21;rbRAP2121;ACBr_SATExtratoESCPOS;dxdborRS21;cxSpreadSheetRS21;dxBarExtItemsRS21;dxWizardControlRS21;CustomIPTransport;dsnap;IndyIPServer;ViasoftVclEstab_XE5;ACBr_MDFe;IndyCore;dclRBBDE2121;rbUSERDesign2121;CloudService;rbTCUI2121;ViasoftUtilsUtils_XE5;FmxTeeUI;FireDACIBDriver;dac210;rbUSER2121;dclRBIBE2121;ACBr_SAT;ViasoftUtilsFunc_XE5;dxDockingRS21;ViasoftVclRTF_XE5;dxLayoutControlRS21;dsnapxml;ACBr_Ponto;JclDeveloperTools;FireDACDb2Driver;ACBR_DeSTDA;TMSScripter;dxPSLnksRS21;ViasoftVclTb97_XE5;dxPSdxDBOCLnkRS21;ACBr_SEF2;cxLibraryRS21;bindcompfmx;ACBr_PAF;cxDataRS21;dxComnRS21;FireDACODBCDriver;RESTBackendComponents;USE;dbrtl;sparkle;FireDACCommon;bindcomp;inetdb;dxPScxTLLnkRS21;ACBr_NFe;DBXOdbcDriver;vclFireDAC;xmlrtl;ibxpress;cxExportRS21;FireDACCommonDriver;dxFlowChartRS21;soaprtl;bindengine;vclactnband;FMXTee;dacvcl210;bindcompvcl;cxPageControlRS21;dxCoreRS21;Jcl;vclie;ACBr_BPe;aurelius;dxPSCoreRS21;ACBr_TEFD;dxPSdxDBTVLnkRS21;dxPScxCommonRS21;dxADOServerModeRS21;FireDACMSSQLDriver;DBXInformixDriver;ViasoftCTB_XE5;Intraweb;ZipMasterR;dxPSTeeChartRS21;dclRBE2121;dsnapcon;DBXFirebirdDriver;TMSScripter_VCL;inet;dxRibbonRS21;dxNavBarRS21;rbDBE2121;FireDACMySQLDriver;soapmidas;vclx;ACBr_SPEDImportar;cxBarEditItemRS21;unidacvcl210;DBXSybaseASADriver;RestDatawareCORE;dxFireDACServerModeRS21;RESTComponents;DbxDevartOracleDriver210;dbexpress;EurekaLogCore;IndyIPClient;dxThemeRS21;rbIDE2121;ACBr_Convenio115;FireDACSqliteDriver;ACBr_LCDPR;FireDACDSDriver;dxDBXServerModeRS21;DBXSqliteDriver;ZComponent;ACBr_EDI;dxRichEditControlRS21;fmx;cxVerticalGridRS21;IndySystem;dxSpreadSheetRS21;TeeDB;tethering;ACBr_CIOT;ViasoftUtilsBase_XE5;vclib;DataSnapClient;dxPScxPivotGridLnkRS21;ACBr_NFeDanfeESCPOS;DataSnapProviderClient;dxPSPrVwRibbonRS21;DBXSybaseASEDriver;unidac210;cxGridRS21;MetropolisUILiveTile;ACBr_ONE;rbIBE2121;ACBr_BPeDabpeESCPOS;unidacfmx210;rbDAD2121;vcldsnap;dxSpellCheckerRS21;crcontrols210;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;ACBr_Serial;vclribbon;dxtrmdRS21;ACBr_SPED;fmxase;vcl;dxBarExtDBItemsRS21;ViasoftVclCompDlg_XE5;dxGDIPlusRS21;DBXMSSQLDriver;IndyIPCommon;CodeSiteExpressPkg;dxPSDBTeeChartRS21;ACBr_NF3eDANF3eESCPOS;ACBr_Boleto;DataSnapFireDAC;FireDACDBXDriver;dxPSdxSpreadSheetLnkRS21;rbRCL2121;soapserver;ACBr_Sintegra;dxdbtrRS21;inetdbxpress;ACBr_NFSe;FireDACInfxDriver;dxPScxGridLnkRS21;dxPSdxFCLnkRS21;ACBr_LFD;adortl;ViasoftVclFormControls_XE5;ACBr_TCP;ViasoftVclControls_XE5;FireDACASADriver;rbDBDE2121;GXDBGrid_XE5;dxTabbedMDIRS21;ZDbc;emsclientfiredac;rtl;dxPSdxOCLnkRS21;DbxClientDriver;dxorgcRS21;dxPScxExtCommonRS21;ZPlain;dxPScxSSLnkRS21;ACBr_MTER;Tee;JclContainers;dxPSdxLCLnkRS21;dclRBDBE2121;ACBr_CTe;dxMapControlRS21;TMSScripter_IDE;dacfmx210;RESTDWDriverFD;ACBr_NFCeECFVirtual;DataSnapNativeClient;svnui;RESTDWDriverRDW;rbDB2121;ACBr_ANe;IndyProtocols;DBXMySQLDriver;cxPivotGridChartRS21;TeeUI;bindcompdbx;dxmdsRS21;dclRBADO2121;ACBr_OpenSSL;FireDACADSDriver;vcltouch;ZCore;ACBr_Reinf;dxServerModeRS21;emsclient;ACBr_SATWS;ACBr_ADRCST;VclSmp;FireDAC;VCLRESTComponents;dxBarDBNavRS21;dxRibbonCustomizationFormRS21;DataSnapConnectors;ViasoftGPFin_XE5;remotedb;ACBr_SATECFVirtual;cxSchedulerGridRS21;rbBDE2121;fmxobj;dclRBFireDAC2121;ZParseSql;rbADO2121;rbRIDE2121;dxPScxVGridLnkRS21;svn;dxBarRS21;FireDACOracleDriver;fmxdae;TicketFrete_XE5;bdertl;tmsbcl;FireDACMSAccDriver;DataSnapIndy10ServerTransport;$(DCC_UsePackage) 58 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 59 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 60 | $(BDS)\bin\default_app.manifest 61 | 62 | 63 | dxPScxSchedulerLnkRS21;cxSchedulerRibbonStyleEventEditorRS21;cxSchedulerRS21;ViasoftVclDB_XE5;TMSScripter_Memo;FireDACPgDriver;xdata;TMSLogging;cxTreeListdxBarPopupMenuRS21;cxPivotGridRS21;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;dxGaugeControlRS21;cxEditorsRS21;DbxCommonDriver;vclimg;dxTileControlRS21;dxPSdxGaugeControlLnkRS21;dbxcds;dxPsPrVwAdvRS21;DatasnapConnectorsFreePascal;TMSScripter_Legacy;vcldb;ViasoftUtilsGeral_XE5;cxTreeListRS21;dxdborRS21;cxSpreadSheetRS21;dxBarExtItemsRS21;dxWizardControlRS21;CustomIPTransport;dsnap;IndyIPServer;IndyCore;CloudService;ViasoftUtilsUtils_XE5;FmxTeeUI;FireDACIBDriver;ViasoftUtilsFunc_XE5;dxDockingRS21;ViasoftVclRTF_XE5;dxLayoutControlRS21;dsnapxml;FireDACDb2Driver;TMSScripter;dxPSLnksRS21;dxPSdxDBOCLnkRS21;cxLibraryRS21;bindcompfmx;cxDataRS21;dxComnRS21;FireDACODBCDriver;RESTBackendComponents;dbrtl;sparkle;FireDACCommon;bindcomp;inetdb;dxPScxTLLnkRS21;DBXOdbcDriver;vclFireDAC;xmlrtl;ibxpress;cxExportRS21;FireDACCommonDriver;dxFlowChartRS21;soaprtl;bindengine;vclactnband;FMXTee;bindcompvcl;cxPageControlRS21;dxCoreRS21;vclie;aurelius;dxPSCoreRS21;dxPSdxDBTVLnkRS21;dxPScxCommonRS21;dxADOServerModeRS21;FireDACMSSQLDriver;DBXInformixDriver;Intraweb;ZipMasterR;dxPSTeeChartRS21;dsnapcon;DBXFirebirdDriver;TMSScripter_VCL;inet;dxRibbonRS21;dxNavBarRS21;FireDACMySQLDriver;soapmidas;vclx;cxBarEditItemRS21;DBXSybaseASADriver;RestDatawareCORE;dxFireDACServerModeRS21;RESTComponents;dbexpress;IndyIPClient;dxThemeRS21;FireDACSqliteDriver;FireDACDSDriver;dxDBXServerModeRS21;DBXSqliteDriver;ZComponent;dxRichEditControlRS21;fmx;cxVerticalGridRS21;IndySystem;dxSpreadSheetRS21;TeeDB;tethering;ViasoftUtilsBase_XE5;vclib;DataSnapClient;dxPScxPivotGridLnkRS21;DataSnapProviderClient;dxPSPrVwRibbonRS21;DBXSybaseASEDriver;cxGridRS21;MetropolisUILiveTile;vcldsnap;dxSpellCheckerRS21;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;vclribbon;dxtrmdRS21;fmxase;vcl;dxBarExtDBItemsRS21;ViasoftVclCompDlg_XE5;dxGDIPlusRS21;DBXMSSQLDriver;IndyIPCommon;dxPSDBTeeChartRS21;DataSnapFireDAC;FireDACDBXDriver;dxPSdxSpreadSheetLnkRS21;soapserver;dxdbtrRS21;inetdbxpress;FireDACInfxDriver;dxPScxGridLnkRS21;dxPSdxFCLnkRS21;adortl;ViasoftVclControls_XE5;FireDACASADriver;dxTabbedMDIRS21;ZDbc;emsclientfiredac;rtl;dxPSdxOCLnkRS21;DbxClientDriver;dxorgcRS21;dxPScxExtCommonRS21;ZPlain;dxPScxSSLnkRS21;Tee;dxPSdxLCLnkRS21;dxMapControlRS21;TMSScripter_IDE;RESTDWDriverFD;DataSnapNativeClient;IndyProtocols;DBXMySQLDriver;cxPivotGridChartRS21;TeeUI;bindcompdbx;dxmdsRS21;FireDACADSDriver;vcltouch;ZCore;dxServerModeRS21;emsclient;VclSmp;FireDAC;VCLRESTComponents;dxBarDBNavRS21;dxRibbonCustomizationFormRS21;DataSnapConnectors;remotedb;cxSchedulerGridRS21;fmxobj;ZParseSql;dxPScxVGridLnkRS21;dxBarRS21;FireDACOracleDriver;fmxdae;tmsbcl;FireDACMSAccDriver;DataSnapIndy10ServerTransport;$(DCC_UsePackage) 64 | 65 | 66 | DEBUG;$(DCC_Define) 67 | true 68 | false 69 | true 70 | true 71 | true 72 | 73 | 74 | false 75 | 76 | 77 | false 78 | RELEASE;$(DCC_Define) 79 | 0 80 | 0 81 | 82 | 83 | 84 | MainSource 85 | 86 | 87 |
FrmMain
88 | 89 | 90 | 91 | 92 | 93 | Cfg_2 94 | Base 95 | 96 | 97 | Base 98 | 99 | 100 | Cfg_1 101 | Base 102 | 103 | 104 | 105 | Delphi.Personality.12 106 | Application 107 | 108 | 109 | 110 | TestDelphi.dpr 111 | 112 | 113 | 114 | 115 | 116 | TestDelphi.exe 117 | true 118 | 119 | 120 | 121 | 122 | 1 123 | .dylib 124 | 125 | 126 | 0 127 | .bpl 128 | 129 | 130 | Contents\MacOS 131 | 1 132 | .dylib 133 | 134 | 135 | 1 136 | .dylib 137 | 138 | 139 | 1 140 | .dylib 141 | 142 | 143 | 144 | 145 | 1 146 | .dylib 147 | 148 | 149 | 0 150 | .dll;.bpl 151 | 152 | 153 | Contents\MacOS 154 | 1 155 | .dylib 156 | 157 | 158 | 1 159 | .dylib 160 | 161 | 162 | 1 163 | .dylib 164 | 165 | 166 | 167 | 168 | 1 169 | 170 | 171 | 1 172 | 173 | 174 | 1 175 | 176 | 177 | 178 | 179 | Contents 180 | 1 181 | 182 | 183 | 184 | 185 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 186 | 1 187 | 188 | 189 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 190 | 1 191 | 192 | 193 | 194 | 195 | res\drawable-normal 196 | 1 197 | 198 | 199 | 200 | 201 | library\lib\x86 202 | 1 203 | 204 | 205 | 206 | 207 | 1 208 | 209 | 210 | 1 211 | 212 | 213 | 1 214 | 215 | 216 | 217 | 218 | ../ 219 | 1 220 | 221 | 222 | 223 | 224 | library\lib\armeabi-v7a 225 | 1 226 | 227 | 228 | 229 | 230 | 1 231 | 232 | 233 | 1 234 | 235 | 236 | 1 237 | 238 | 239 | 240 | 241 | res\drawable-xlarge 242 | 1 243 | 244 | 245 | 246 | 247 | res\drawable-xhdpi 248 | 1 249 | 250 | 251 | 252 | 253 | 1 254 | 255 | 256 | 1 257 | 258 | 259 | 1 260 | 261 | 262 | 263 | 264 | res\drawable-xxhdpi 265 | 1 266 | 267 | 268 | 269 | 270 | library\lib\mips 271 | 1 272 | 273 | 274 | 275 | 276 | res\drawable 277 | 1 278 | 279 | 280 | 281 | 282 | Contents\MacOS 283 | 1 284 | 285 | 286 | 1 287 | 288 | 289 | 0 290 | 291 | 292 | 293 | 294 | Contents\MacOS 295 | 1 296 | .framework 297 | 298 | 299 | 0 300 | 301 | 302 | 303 | 304 | res\drawable-small 305 | 1 306 | 307 | 308 | 309 | 310 | ../ 311 | 1 312 | 313 | 314 | ../ 315 | 1 316 | 317 | 318 | 319 | 320 | Contents\MacOS 321 | 1 322 | 323 | 324 | 1 325 | 326 | 327 | Contents\MacOS 328 | 0 329 | 330 | 331 | 332 | 333 | classes 334 | 1 335 | 336 | 337 | 338 | 339 | 1 340 | 341 | 342 | 1 343 | 344 | 345 | 1 346 | 347 | 348 | 349 | 350 | 1 351 | 352 | 353 | 1 354 | 355 | 356 | 1 357 | 358 | 359 | 360 | 361 | res\drawable 362 | 1 363 | 364 | 365 | 366 | 367 | Contents\Resources 368 | 1 369 | 370 | 371 | 372 | 373 | 1 374 | 375 | 376 | 1 377 | 378 | 379 | 380 | 381 | 1 382 | 383 | 384 | 1 385 | 386 | 387 | 1 388 | 389 | 390 | 391 | 392 | library\lib\armeabi-v7a 393 | 1 394 | 395 | 396 | 1 397 | 398 | 399 | 0 400 | 401 | 402 | Contents\MacOS 403 | 1 404 | 405 | 406 | 1 407 | 408 | 409 | 1 410 | 411 | 412 | 413 | 414 | library\lib\armeabi 415 | 1 416 | 417 | 418 | 419 | 420 | res\drawable-large 421 | 1 422 | 423 | 424 | 425 | 426 | 0 427 | 428 | 429 | 0 430 | 431 | 432 | 0 433 | 434 | 435 | Contents\MacOS 436 | 0 437 | 438 | 439 | 0 440 | 441 | 442 | 0 443 | 444 | 445 | 446 | 447 | 1 448 | 449 | 450 | 1 451 | 452 | 453 | 1 454 | 455 | 456 | 457 | 458 | res\drawable-ldpi 459 | 1 460 | 461 | 462 | 463 | 464 | res\values 465 | 1 466 | 467 | 468 | 469 | 470 | 1 471 | 472 | 473 | 1 474 | 475 | 476 | 1 477 | 478 | 479 | 480 | 481 | res\drawable-mdpi 482 | 1 483 | 484 | 485 | 486 | 487 | res\drawable-hdpi 488 | 1 489 | 490 | 491 | 492 | 493 | 1 494 | 495 | 496 | 497 | 498 | 499 | 500 | 501 | 502 | 503 | 504 | 505 | True 506 | False 507 | 508 | 509 | 12 510 | 511 | 512 | 513 | 514 | 515 | -------------------------------------------------------------------------------- /Test/TestDelphi.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <BuildModes> 19 | <Item Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | </RunParams> 28 | <RequiredPackages> 29 | <Item> 30 | <PackageName Value="zcomponent"/> 31 | </Item> 32 | <Item> 33 | <PackageName Value="LCL"/> 34 | </Item> 35 | </RequiredPackages> 36 | <Units> 37 | <Unit> 38 | <Filename Value="TestDelphi.dpr"/> 39 | <IsPartOfProject Value="True"/> 40 | </Unit> 41 | <Unit> 42 | <Filename Value="uMain.pas"/> 43 | <IsPartOfProject Value="True"/> 44 | <ComponentName Value="FrmMain"/> 45 | <HasResources Value="True"/> 46 | <ResourceBaseClass Value="Form"/> 47 | </Unit> 48 | <Unit> 49 | <Filename Value="..\Core\DBPoolConnection.pas"/> 50 | <IsPartOfProject Value="True"/> 51 | </Unit> 52 | <Unit> 53 | <Filename Value="..\Core\DBPoolConnection.Interfaces.pas"/> 54 | <IsPartOfProject Value="True"/> 55 | </Unit> 56 | </Units> 57 | </ProjectOptions> 58 | <CompilerOptions> 59 | <Version Value="11"/> 60 | <PathDelim Value="\"/> 61 | <SearchPaths> 62 | <IncludeFiles Value="..\Core"/> 63 | <OtherUnitFiles Value="..\Core"/> 64 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 65 | </SearchPaths> 66 | <Parsing> 67 | <SyntaxOptions> 68 | <SyntaxMode Value="delphi"/> 69 | </SyntaxOptions> 70 | </Parsing> 71 | <Linking> 72 | <Debugging> 73 | <DebugInfoType Value="dsDwarf2Set"/> 74 | </Debugging> 75 | <Options> 76 | <Win32> 77 | <GraphicApplication Value="True"/> 78 | </Win32> 79 | </Options> 80 | </Linking> 81 | <Other> 82 | <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/> 83 | </Other> 84 | </CompilerOptions> 85 | <Debugging> 86 | <Exceptions> 87 | <Item> 88 | <Name Value="EAbort"/> 89 | </Item> 90 | <Item> 91 | <Name Value="ECodetoolError"/> 92 | </Item> 93 | <Item> 94 | <Name Value="EFOpenError"/> 95 | </Item> 96 | </Exceptions> 97 | </Debugging> 98 | </CONFIG> 99 | -------------------------------------------------------------------------------- /Test/TestDelphi.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="12"/> 6 | <BuildModes Active="Default"/> 7 | <Units> 8 | <Unit> 9 | <Filename Value="TestDelphi.dpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <CursorPos X="50" Y="7"/> 12 | <UsageCount Value="32"/> 13 | <Loaded Value="True"/> 14 | </Unit> 15 | <Unit> 16 | <Filename Value="uMain.pas"/> 17 | <IsPartOfProject Value="True"/> 18 | <ComponentName Value="FrmMain"/> 19 | <HasResources Value="True"/> 20 | <ResourceBaseClass Value="Form"/> 21 | <EditorIndex Value="1"/> 22 | <TopLine Value="53"/> 23 | <CursorPos X="55" Y="81"/> 24 | <UsageCount Value="32"/> 25 | <Loaded Value="True"/> 26 | <LoadedDesigner Value="True"/> 27 | </Unit> 28 | <Unit> 29 | <Filename Value="..\Core\DBPoolConnection.pas"/> 30 | <IsPartOfProject Value="True"/> 31 | <EditorIndex Value="4"/> 32 | <TopLine Value="15"/> 33 | <CursorPos X="49" Y="34"/> 34 | <UsageCount Value="32"/> 35 | <Bookmarks Count="1"> 36 | <Item0 X="9" Y="120" ID="1"/> 37 | </Bookmarks> 38 | <Loaded Value="True"/> 39 | </Unit> 40 | <Unit> 41 | <Filename Value="..\Core\DBPoolConnection.Interfaces.pas"/> 42 | <IsPartOfProject Value="True"/> 43 | <IsVisibleTab Value="True"/> 44 | <EditorIndex Value="8"/> 45 | <TopLine Value="5"/> 46 | <CursorPos X="40" Y="18"/> 47 | <UsageCount Value="32"/> 48 | <Loaded Value="True"/> 49 | </Unit> 50 | <Unit> 51 | <Filename Value="C:\lazarus\fpc\3.2.2\source\rtl\win64\classes.pp"/> 52 | <UnitName Value="Classes"/> 53 | <EditorIndex Value="7"/> 54 | <TopLine Value="25"/> 55 | <CursorPos X="51" Y="31"/> 56 | <UsageCount Value="14"/> 57 | <Loaded Value="True"/> 58 | </Unit> 59 | <Unit> 60 | <Filename Value="C:\lazarus\fpc\3.2.2\source\packages\rtl-generics\src\inc\generics.dictionariesh.inc"/> 61 | <EditorIndex Value="6"/> 62 | <TopLine Value="603"/> 63 | <CursorPos X="44" Y="615"/> 64 | <UsageCount Value="13"/> 65 | <Loaded Value="True"/> 66 | </Unit> 67 | <Unit> 68 | <Filename Value="C:\lazarus\fpc\3.2.2\source\packages\rtl-generics\src\generics.collections.pas"/> 69 | <UnitName Value="Generics.Collections"/> 70 | <EditorIndex Value="-1"/> 71 | <TopLine Value="132"/> 72 | <CursorPos X="52" Y="144"/> 73 | <UsageCount Value="12"/> 74 | </Unit> 75 | <Unit> 76 | <Filename Value="C:\lazarus\fpc\3.2.2\source\rtl\objpas\classes\classesh.inc"/> 77 | <EditorIndex Value="2"/> 78 | <TopLine Value="1675"/> 79 | <CursorPos X="3" Y="1687"/> 80 | <UsageCount Value="13"/> 81 | <Loaded Value="True"/> 82 | </Unit> 83 | <Unit> 84 | <Filename Value="C:\lazarus\fpc\3.2.2\source\rtl\objpas\sysutils\sysutilh.inc"/> 85 | <EditorIndex Value="3"/> 86 | <UsageCount Value="13"/> 87 | <Loaded Value="True"/> 88 | </Unit> 89 | <Unit> 90 | <Filename Value="C:\lazarus\fpc\3.2.2\source\packages\fcl-base\src\syncobjs.pp"/> 91 | <EditorIndex Value="5"/> 92 | <TopLine Value="110"/> 93 | <CursorPos X="57" Y="118"/> 94 | <UsageCount Value="10"/> 95 | <Loaded Value="True"/> 96 | </Unit> 97 | <Unit> 98 | <Filename Value="..\Core\DBPoolConnection.Types.pas"/> 99 | <EditorIndex Value="9"/> 100 | <CursorPos X="111" Y="14"/> 101 | <UsageCount Value="10"/> 102 | <Loaded Value="True"/> 103 | <DefaultSyntaxHighlighter Value="Delphi"/> 104 | </Unit> 105 | </Units> 106 | <JumpHistory HistoryIndex="28"> 107 | <Position> 108 | <Filename Value="..\Core\DBPoolConnection.pas"/> 109 | <Caret Line="123" Column="36" TopLine="117"/> 110 | </Position> 111 | <Position> 112 | <Filename Value="..\Core\DBPoolConnection.pas"/> 113 | <Caret Line="51" Column="17" TopLine="42"/> 114 | </Position> 115 | <Position> 116 | <Filename Value="uMain.pas"/> 117 | <Caret Line="75" Column="58" TopLine="70"/> 118 | </Position> 119 | <Position> 120 | <Filename Value="..\Core\DBPoolConnection.Interfaces.pas"/> 121 | <Caret Line="25" Column="20"/> 122 | </Position> 123 | <Position> 124 | <Filename Value="..\Core\DBPoolConnection.Types.pas"/> 125 | <Caret Line="14" Column="111"/> 126 | </Position> 127 | <Position> 128 | <Filename Value="..\Core\DBPoolConnection.pas"/> 129 | <Caret Line="193" Column="57" TopLine="175"/> 130 | </Position> 131 | <Position> 132 | <Filename Value="..\Core\DBPoolConnection.pas"/> 133 | </Position> 134 | <Position> 135 | <Filename Value="..\Core\DBPoolConnection.pas"/> 136 | <Caret Line="50" Column="31" TopLine="19"/> 137 | </Position> 138 | <Position> 139 | <Filename Value="..\Core\DBPoolConnection.pas"/> 140 | <Caret Line="182" Column="68" TopLine="162"/> 141 | </Position> 142 | <Position> 143 | <Filename Value="..\Core\DBPoolConnection.pas"/> 144 | </Position> 145 | <Position> 146 | <Filename Value="..\Core\DBPoolConnection.pas"/> 147 | <Caret Line="25" Column="32"/> 148 | </Position> 149 | <Position> 150 | <Filename Value="..\Core\DBPoolConnection.pas"/> 151 | <Caret Line="29" Column="40"/> 152 | </Position> 153 | <Position> 154 | <Filename Value="..\Core\DBPoolConnection.pas"/> 155 | <Caret Line="34" Column="25" TopLine="6"/> 156 | </Position> 157 | <Position> 158 | <Filename Value="..\Core\DBPoolConnection.pas"/> 159 | <Caret Line="36" Column="43" TopLine="11"/> 160 | </Position> 161 | <Position> 162 | <Filename Value="..\Core\DBPoolConnection.pas"/> 163 | <Caret Line="39" Column="76" TopLine="11"/> 164 | </Position> 165 | <Position> 166 | <Filename Value="..\Core\DBPoolConnection.pas"/> 167 | <Caret Line="41" Column="76" TopLine="13"/> 168 | </Position> 169 | <Position> 170 | <Filename Value="..\Core\DBPoolConnection.pas"/> 171 | <Caret Line="52" Column="66" TopLine="24"/> 172 | </Position> 173 | <Position> 174 | <Filename Value="..\Core\DBPoolConnection.pas"/> 175 | <Caret Line="85" Column="30" TopLine="57"/> 176 | </Position> 177 | <Position> 178 | <Filename Value="..\Core\DBPoolConnection.pas"/> 179 | <Caret Line="169" Column="30" TopLine="141"/> 180 | </Position> 181 | <Position> 182 | <Filename Value="..\Core\DBPoolConnection.pas"/> 183 | <Caret Line="312" Column="86" TopLine="284"/> 184 | </Position> 185 | <Position> 186 | <Filename Value="..\Core\DBPoolConnection.pas"/> 187 | <Caret Line="325" Column="53" TopLine="297"/> 188 | </Position> 189 | <Position> 190 | <Filename Value="uMain.pas"/> 191 | <Caret Line="62" Column="25" TopLine="56"/> 192 | </Position> 193 | <Position> 194 | <Filename Value="uMain.pas"/> 195 | </Position> 196 | <Position> 197 | <Filename Value="uMain.pas"/> 198 | <Caret Line="41" Column="57" TopLine="19"/> 199 | </Position> 200 | <Position> 201 | <Filename Value="uMain.pas"/> 202 | <Caret Line="70" Column="87" TopLine="50"/> 203 | </Position> 204 | <Position> 205 | <Filename Value="uMain.pas"/> 206 | </Position> 207 | <Position> 208 | <Filename Value="uMain.pas"/> 209 | <Caret Line="81" Column="55" TopLine="53"/> 210 | </Position> 211 | <Position> 212 | <Filename Value="..\Core\DBPoolConnection.pas"/> 213 | <Caret Line="34" Column="49" TopLine="15"/> 214 | </Position> 215 | <Position> 216 | <Filename Value="..\Core\DBPoolConnection.Interfaces.pas"/> 217 | <Caret Line="17" Column="43" TopLine="2"/> 218 | </Position> 219 | </JumpHistory> 220 | <RunParams> 221 | <FormatVersion Value="2"/> 222 | <Modes ActiveMode=""/> 223 | </RunParams> 224 | </ProjectSession> 225 | </CONFIG> 226 | -------------------------------------------------------------------------------- /Test/TestDelphi.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ronaldobim/PascalDBPoolConnection/b7c59e4f33f12f2d4c41f87c1b86acdfe3bf4051/Test/TestDelphi.res -------------------------------------------------------------------------------- /Test/TestDelphi.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=7898 3 | DesignerSecs=210 4 | InspectorSecs=78 5 | CompileSecs=112147 6 | OtherSecs=427 7 | StartTime=04/05/2022 20:54:30 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=975 11 | -------------------------------------------------------------------------------- /Test/uMain.dfm: -------------------------------------------------------------------------------- 1 | object FrmMain: TFrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Test' 5 | ClientHeight = 299 6 | ClientWidth = 652 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Button1: TButton 18 | Left = 16 19 | Top = 8 20 | Width = 75 21 | Height = 25 22 | Caption = 'Test' 23 | TabOrder = 0 24 | OnClick = Button1Click 25 | end 26 | object Memo1: TMemo 27 | Left = 16 28 | Top = 39 29 | Width = 628 30 | Height = 242 31 | TabOrder = 1 32 | end 33 | object Button2: TButton 34 | Left = 97 35 | Top = 8 36 | Width = 75 37 | Height = 25 38 | Caption = 'Status' 39 | TabOrder = 2 40 | OnClick = Button2Click 41 | end 42 | end 43 | -------------------------------------------------------------------------------- /Test/uMain.lfm: -------------------------------------------------------------------------------- 1 | object FrmMain: TFrmMain 2 | Left = 378 3 | Height = 299 4 | Top = 192 5 | Width = 652 6 | Caption = 'Test' 7 | ClientHeight = 299 8 | ClientWidth = 652 9 | Color = clBtnFace 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | OnCreate = FormCreate 14 | LCLVersion = '2.2.0.4' 15 | object Button1: TButton 16 | Left = 16 17 | Height = 25 18 | Top = 8 19 | Width = 75 20 | Caption = 'Test' 21 | OnClick = Button1Click 22 | TabOrder = 0 23 | end 24 | object Memo1: TMemo 25 | Left = 16 26 | Height = 242 27 | Top = 39 28 | Width = 628 29 | TabOrder = 1 30 | end 31 | object Button2: TButton 32 | Left = 97 33 | Height = 25 34 | Top = 8 35 | Width = 75 36 | Caption = 'Status' 37 | OnClick = Button2Click 38 | TabOrder = 2 39 | end 40 | end 41 | -------------------------------------------------------------------------------- /Test/uMain.pas: -------------------------------------------------------------------------------- 1 | unit uMain; 2 | 3 | {$IFDEF FPC} 4 | {$MODE Delphi} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | SysUtils, Variants, Classes, 11 | Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, 12 | DBPoolConnection, ZAbstractConnection, ZConnection, 13 | DBPoolConnection.Interfaces, 14 | DBPoolConnection.Types; 15 | 16 | type 17 | 18 | { TFrmMain } 19 | 20 | TFrmMain = class(TForm) 21 | Button1: TButton; 22 | Memo1: TMemo; 23 | Button2: TButton; 24 | procedure Button1Click(Sender: TObject); 25 | procedure FormCreate(Sender: TObject); 26 | procedure Button2Click(Sender: TObject); 27 | private 28 | { Private declarations } 29 | public 30 | { Public declarations } 31 | end; 32 | 33 | TThreadTest = class(TThread) 34 | private 35 | FStatus: string; 36 | procedure Logar; 37 | public 38 | procedure Execute; override; 39 | end; 40 | 41 | function NewDatabase(ATenantDatabase: string): TObject; 42 | 43 | var 44 | FrmMain: TFrmMain; 45 | FPool: IDBPoolConnection; 46 | 47 | 48 | implementation 49 | 50 | {$IFnDEF FPC} 51 | {$R *.dfm} 52 | {$ELSE} 53 | {$R *.lfm} 54 | {$ENDIF} 55 | 56 | procedure TFrmMain.Button1Click(Sender: TObject); 57 | var 58 | i: Integer; 59 | t: TThreadTest; 60 | begin 61 | for i := 1 to 200 do 62 | begin 63 | t := TThreadTest.Create(True); 64 | t.FreeOnTerminate := True; 65 | t.Start; 66 | end; 67 | end; 68 | 69 | procedure TFrmMain.Button2Click(Sender: TObject); 70 | begin 71 | ShowMessage(FPool.GetStatus); 72 | end; 73 | 74 | procedure TFrmMain.FormCreate(Sender: TObject); 75 | begin 76 | FPool := TDBPoolConnection.GetInstance 77 | .SetMaxPool(100) 78 | .SetOnCreateDatabaseComponent(NewDatabase); 79 | end; 80 | 81 | function NewDatabase(ATenantDatabase: string): TObject; 82 | var 83 | Conn: TZConnection; 84 | begin 85 | Conn := TZConnection.Create(nil); 86 | //..config your connection and open connection, check your TenantDatabse in Ini File for example 87 | //Conn.Open; 88 | //Sleep(100); //Uncomment this line to test with delay 89 | Result := Conn; 90 | end; 91 | 92 | 93 | { TThreadTest } 94 | 95 | procedure TThreadTest.Execute; 96 | var 97 | vDBConnection: IDBConnection; 98 | begin 99 | vDBConnection := FPool.GetDBConnection; 100 | if vDBConnection <> nil then 101 | begin 102 | FStatus := 'OK GetConnection'; 103 | //Using your connection 104 | //ZQuery.Connection := vDBConnection.DatabaseComponent as TZConnection; 105 | //ZQuery.SQL.Text := 'select * from dual'; 106 | //ZQuery.Open; 107 | end 108 | else 109 | FStatus := 'FAIL GetConnection'; 110 | Synchronize(Logar); 111 | end; 112 | 113 | procedure TThreadTest.Logar; 114 | begin 115 | FrmMain.Memo1.Lines.Add(FStatus); 116 | end; 117 | 118 | end. 119 | --------------------------------------------------------------------------------