BackLog Database Monitor

{***************************************************************}
{                                                               }
{           Leopard Report                                      }
{           Copyright (C) 2012 Carlos Dias da Silva F.          }
{           filhotecmail@gmail.com                              }
{***************************************************************}
unit Dao.Transactions.Monitor.Service.Work;

interface
 uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 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.Phys.FB,
  FireDAC.Phys.FBDef, FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
  Vcl.StdCtrls, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.Moni.Base,
  FireDAC.Moni.RemoteClient,FireDAC.Moni.Custom;

 type TCustomMonitorTypes = (MonitorCustom,MonitorFlat,MonitorRemote);

 type
      ITransactMonitorServiceWork = Interface
      ['{A43E4929-A02D-4353-BBC1-303462FE6BCC}']
      function SendNotify(Sender: TProc<TObject>):ITransactMonitorServiceWork;
      function Monitor:TObject;
  End;

 type TTransactMonitorServiceWork = class Abstract(TInterfacedObject, ITransactMonitorServiceWork)

  private
     FConnection: TFDCustomConnection;
     FMonitor   : TObject;
     FDataLog   : TFDMemTable;
  {$REGION 'prepair Components'}
     procedure InternalCreateCustomMonitor;
     procedure InternalPrepareDataLog;
  {$ENDREGION}
  protected
    function SendNotify(Sender: TProc<TObject>):ITransactMonitorServiceWork; virtual;
    procedure OnOutputEvent(ASender: TFDMoniClientLinkBase; const AClassName, AObjName,
              AMessage: string);
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    Constructor Create(AConnection: TFDCustomConnection; AMonitorType: TCustomMonitorTypes); Virtual;
    class function New(AConnection: TFDCustomConnection; AMonitorType: TCustomMonitorTypes):IInterface; virtual; abstract;
    function Monitor: TObject;
  end;

  type TTransactCustomMonitorServiceWork<ITransactMonitorServiceWork> = class(TTransactMonitorServiceWork)
  public
    class function New(AConnection: TFDCustomConnection;
          AMonitorType: TCustomMonitorTypes = MonitorCustom): IInterface; reintroduce; Overload;
  end;

implementation

{ TTransactMonitorServiceWork }
procedure TTransactMonitorServiceWork.AfterConstruction;
begin
  inherited;

end;

procedure TTransactMonitorServiceWork.BeforeDestruction;
begin
  inherited;
  FreeAndNil( FDataLog );
end;

constructor TTransactMonitorServiceWork.Create(AConnection: TFDCustomConnection; AMonitorType: TCustomMonitorTypes);
begin
 Assert(AConnection <> nil,'O Componente de Conexão TFDCustomConnection não pode ser nil');
 FConnection := AConnection;
 FDataLog := TFDMemTable.Create(nil);
 case AMonitorType of
  MonitorCustom: InternalCreateCustomMonitor;
  MonitorFlat  : ;
  MonitorRemote: ;
 end;

end;

procedure TTransactMonitorServiceWork.InternalCreateCustomMonitor;
begin
 FMonitor:= TFDMoniCustomClientLink.Create(FConnection);
 ( FMonitor as TFDMoniCustomClientLink).OnOutput := OnOutputEvent;
 ( FConnection as TFDConnection).Params.MonitorBy:= mbCustom;
end;

procedure TTransactMonitorServiceWork.InternalPrepareDataLog;
begin
 FDataLog.FieldDefs.Clear;
 with FDataLog.FieldDefs do
 begin
   Add('Data',ftDate);
   Add('Hora',ftTime);
   Add('ObjectName',ftString,60);
   Add('ClassName',ftString,60);
   Add('Message',ftWideMemo,5000);
 end;
 FDataLog.CreateDataSet;
 FDataLog.Open;
end;

function TTransactMonitorServiceWork.Monitor: TObject;
begin
 Result := FMonitor;
end;

procedure TTransactMonitorServiceWork.OnOutputEvent(ASender: TFDMoniClientLinkBase; const AClassName, AObjName,
  AMessage: string);
begin
 FDataLog.AppendRecord([Now,Now,AObjName,AClassName,AMessage]);
 FDataLog.Refresh;
end;

function TTransactMonitorServiceWork.SendNotify(Sender: TProc<TObject>): ITransactMonitorServiceWork;
begin
 if Assigned(Sender) then
    Sender(FDataLog);
end;

{ TTransactCustomMonitorServiceWork<ITransactMonitorServiceWork> }

class function TTransactCustomMonitorServiceWork<ITransactMonitorServiceWork>.New(
  AConnection: TFDCustomConnection; AMonitorType: TCustomMonitorTypes = MonitorCustom): IInterface;
begin
 Result := TTransactCustomMonitorServiceWork<ITransactMonitorServiceWork>.Create(AConnection,MonitorCustom);

end;

end.