FireDAC DataSnap Connection Pool

First use these units as follows. Of course, also need some other units

uses
  SysUtils, Classes,
  DB,Variants, Windows, Math,
  System.IniFiles,
  SynCommons,
  IPPeerClient,
  FireDAC.Comp.Client,
  FireDAC.Phys.DS,
  FireDAC.Comp.UI,
  FireDAC.Phys.Intf,
  FireDAC.Stan.Util,
  FireDAC.Stan.Def,
  FireDAC.Stan.Pool ,
  FireDAC.Stan.Error,
  FireDAC.Stan.Intf,
  Datasnap.DSHTTPLayer;

then we need a record to read configs, you can implement it as you like

  TDSPoolConfig = record
    CleanupTimeout: string;
    ExpireTimeout: string;
    MaximumItems: string;
    Server: string;
    Port: string;
    DSUserName, DSPassword: string;
    IsHttpClient:Boolean;
    procedure ReadConfig;
  end;

ok, now come the pool

TDSConnectionPool = class(TComponent)
  const
    POOL_DEFNAME = 'POOL';
  private
    DSLink: TFDPhysDSDriverLink;
    WaitCursor:TFDGUIxWaitCursor;
    fIsReConn: Boolean;
    Config:TDSPoolConfig;
    function GetCount: Integer;
    procedure LiftUp;
    procedure ShutDown;
    procedure OnError(ASender, AInitiator: TObject; var AException: Exception);
    procedure OnRecover(ASender, AInitiator: TObject;AException: Exception; var AAction: TFDPhysConnectionRecoverAction);
    procedure OnRestored(ASender:TObject);
    procedure OnLost(ASender:TObject);
  public
    constructor Create; overload;
    destructor Destroy; override;
    function Lock: TFDConnection;
    procedure WriteParams;
    property Count:Integer read GetCount;
    // if true the connection is not active
    property IsReConn:Boolean read fIsReConn write fIsReConn;
  end;

my implementation

constructor TDSConnectionPool.Create;
begin
  DSLink := TFDPhysDSDriverLink.Create(self);
  WaitCursor := TFDGUIxWaitCursor.Create(self);
  Config.ReadConfig;
  LiftUp;
end;

destructor TDSConnectionPool.Destroy;
begin
  ShutDown;
  FDFreeAndNil(DSLink);
  FDFreeAndNil(WaitCursor);
  inherited;
end;

function TDSConnectionPool.Lock: TFDConnection;
begin
  Result := TFDConnection.Create(nil);
  Result.ConnectionDefName := POOL_DEFNAME;
  // make some different actions for main thread and other thread
  if GetCurrentThreadID = MainThreadID then
  begin
    Result.OnRecover := OnRecover;
    Result.OnRestored := OnRestored;
  end
  else
  begin
    Result.OnRecover := OnRecoverIgnore;
    Result.OnRestored := OnRestored;
  end;
end;

function TDSConnectionPool.GetCount: Integer;
begin
  Result := FDManager.ConnectionCount;
end;

procedure TDSConnectionPool.LiftUp;
var
  oParams: TStrings;
begin
  oParams := TStringList.Create;
  oParams.Add('DriverID=DS');
  oParams.Add('Server='+ Config.Server);
  oParams.Add('Port='+  Config.Port);
  oParams.Add('Pooled='+  'True');
  oParams.Add('POOL_CleanupTimeout='+  Config.CleanupTimeout);
  oParams.Add('POOL_ExpireTimeout='+  Config.ExpireTimeout);
  oParams.Add('POOL_MaximumItems='+  Config.MaximumItems);
  // also can support http protocol
  if Config.IsHttpClient then
    oParams.Add('Protocol='+  'http')
  else
    oParams.Add('Protocol='+  'tcp/ip');

  //oParams.Add('LoginTimeout='+'2000');
  //oParams.Add('CommunicationTimeout='+'2000');
  oParams.Add('User_Name='+  Config.DSUserName);
  oParams.Add('Password='+  Config.DSPassword);

//  FDManager.ResourceOptions.AutoReconnect := True;
  FDManager.AddConnectionDef(POOL_DEFNAME, 'DS', oParams);
  FreeAndNil(oParams);

  FDManager.Active := True;
end;

// may be used to write out params to file for debug
procedure TDSConnectionPool.WriteParams;
begin
 FileFromString(RecordSaveJSON(Config,TypeInfo(TDSPoolConfig)),
   ExtractFilePath(ParamStr(0))+'ConnParam.connection',True);
end;

procedure TDSConnectionPool.ShutDown;
begin
  FDManager.CloseConnectionDef(POOL_DEFNAME);
  FDManager.Close;
end;

procedure TDSConnectionPool.OnError(ASender, AInitiator: TObject;
  var AException: Exception);
begin
  // log error
end;

procedure TDSConnectionPool.OnRecover(ASender, AInitiator: TObject;
  AException: Exception; var AAction: TFDPhysConnectionRecoverAction);
begin
  IsReConn := True;

  // set global flag
  if ReConnectionCount = 0 then
  begin
    ReConnectionCount := ReConnectionCount + 1;
  end
  else
  begin
    ReConnectionCount := ReConnectionCount + 1;
  end;
  AAction := faFail; // if set to faRetry, this event will be triggered many times
end;

procedure TDSConnectionPool.OnRestored(ASender: TObject);
begin
  IsReConn := False;
  // set global flag
  if ReConnectionCount > 0 then
  begin
    ReConnectionCount := 0;
  end
  else
  begin
    ReConnectionCount := 0;
  end;
end;

procedure TDSConnectionPool.OnLost(ASender: TObject);
begin
  // notify to handle connection lost. only when faRetry
end;

procedure TDSConnectionPool.OnRecoverIgnore(ASender, AInitiator: TObject;
  AException: Exception; var AAction: TFDPhysConnectionRecoverAction);
begin
  // can do something different here when get connection in a thread

  IsReConn := True;
  // set global flag
  if ReConnectionCount = 0 then
  begin
    ReConnectionCount := ReConnectionCount + 1;
  end
  else
  begin
    ReConnectionCount := ReConnectionCount + 1;
  end;
  AAction := faFail;
end;