IsapiScale/IsapiPool.pas at main · RDP1974/IsapiScale · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
unit IsapiPool;

// 7 jul 2025 Roberto Della Pasqua www.dellapasqua.com
// 11 jul 2025 added trap exception for reconnect, tested working

interface

uses
  Windows,
  Classes,
  System.SysUtils,
  FireDAC.Stan.Intf,
  FireDAC.Stan.Option,
  FireDAC.Stan.Error,
  FireDAC.UI.Intf,
  FireDAC.Phys.Intf,
  FireDAC.Stan.Def,
  FireDAC.Stan.Pool,
  FireDAC.Stan.Async,
  FireDAC.Phys,
  FireDAC.VCLUI.Wait,
  FireDAC.Stan.Param,
  FireDAC.DatS,
  FireDAC.DApt.Intf,
  FireDAC.DApt,
  FireDAC.Comp.DataSet,
  FireDAC.Comp.Client;

threadvar
  DBC: TFDConnection;
threadvar
  Q: TFDQuery;
threadvar
  Q2: TFDQuery; // so to permit nested queries dataset
threadvar
  ThInit: boolean;

type
  TConnRecover = class
   procedure Recover(ASender, AInitiator: TObject; AException: Exception; var AAction: TFDPhysConnectionRecoverAction);
end;

threadvar
  RetryC: TConnRecover;

procedure InitConn;

implementation

procedure InitPool;
var
  oParams: TStrings;
begin
  oParams := TStringList.Create;
  oParams.Add('DriverID=MYSQL');
  oParams.Add('Password=1234');
  oParams.Add('User_Name=db');
  oParams.Add('Server=localhost');
  oParams.Add('Database=world');
  oParams.Add('Pooled=True');
  oParams.Add('Compress=False');
  oParams.Add('UseSSL=False');
  oParams.Add('POOL_CleanupTimeout=3600000');
  oParams.Add('POOL_ExpireTimeout=600000');
  oParams.Add('POOL_MaximumItems=200');
  FDManager.Close;

  while FDManager.State <> dmsInactive do
    Sleep(0);

  FDManager.Open;
  FDManager.AddConnectionDef('MySQL_Pool', 'MySQL', oParams);
  oParams.Free;
end;

procedure TConnRecover.Recover(ASender, AInitiator: TObject; AException: Exception; var AAction: TFDPhysConnectionRecoverAction);
begin
 if (AException is EFDDBEngineException) and (EFDDBEngineException(AException).Kind = ekServerGone) then
    AAction := faRetry
 else
    AAction := faFail;
end;

procedure InitConn;
begin
  ThInit:=True;
  RetryC := TConnRecover.Create;
  DBC := TFDConnection.Create(nil);
  DBC.ConnectionDefName := 'MySQL_Pool';
  DBC.LoginPrompt := False;
  DBC.FetchOptions.Mode := fmAll;
  DBC.FetchOptions.Unidirectional := True;
  DBC.UpdateOptions.RequestLive := False;
  DBC.OnRecover := RetryC.Recover;
  Q := TFDQuery.Create(nil);
  Q.Connection := DBC;
  Q.FetchOptions.Mode := fmAll;
  Q.FetchOptions.Unidirectional := True;
  Q.UpdateOptions.RequestLive := False;
  Q2 := TFDQuery.Create(nil);
  Q2.Connection := DBC;
  Q2.FetchOptions.Mode := fmAll;
  Q2.FetchOptions.Unidirectional := True;
  Q2.UpdateOptions.RequestLive := False;
  DBC.Connected := True;
end;

initialization
 InitPool;

end.