Como é de conhecimento da comunidade o FireDac não tem suporte completo ao Firebird3, já que o lançamento do FB3 veio depois do lançamento do Berlin.

Quando se trabalha com Package (novidade no FB3) não é possível escolher na IDE qual o procedimento a executar no componente TFDStoredProc.
Uma forma de fazer isto é escrevendo um editor (delphi way) para auxiliar a propriedade StoredProcName…

[code lang=”pascal”]

unit Data.fireStoredProcEditor;

interface

uses
SysUtils, Classes, DesignIntf, DesignEditors, DB;

type
TFireStoredProcNames = class(TStringProperty)
private
procedure GetValues(Proc: TGetStrProc); override;

public
function GetAttributes: TPropertyAttributes; override;
end;

procedure Register;

implementation

uses FireDAC.Comp.Client, FireDAC.Phys.Intf;

procedure Register;
begin
RegisterPropertyEditor(TypeInfo(string), TFDCustomStoredProc,
‘StoredProcName’, TFireStoredProcNames);
end;

{ TFireStoredProcNames }

function TFireStoredProcNames.GetAttributes: TPropertyAttributes;
begin
result := [paValueList];
end;

procedure TFireStoredProcNames.GetValues(Proc: TGetStrProc);
var
DB: TFDCustomStoredProc;
qry: TFDQuery;
eh3:boolean;
oMetaIntf: IFDPhysConnectionMetadata;
function iff(b:boolean;t,f:string):string;
begin
if b then result := t else result := f;
end;
begin
if (GetComponent(0).InheritsFrom(TFDCustomStoredProc)) then
begin
DB := TFDCustomStoredProc(GetComponent(0));
if assigned(DB.Connection) then
begin
if (DB.Connection.DriverName = ‘FB’) then
begin
oMetaIntf := DB.Connection.ConnectionMetaDataIntf;
eh3 := oMetaIntf.ServerVersion.ToString[1]=’3′;
qry := TFDQuery.create(nil);
try
qry.Connection := DB.Connection;
qry.SQL.Text := ‘select rdb$procedure_name sName from rdb$procedures ‘;
if eh3 then
qry.SQL.Text := qry.SQL.Text+ iff(db.PackageName<>”, ‘ where rdb$package_name = ‘ + QuotedStr(DB.PackageName.ToUpper),’ where rdb$package_name is null ‘);
qry.Open;
with qry do
while eof = false do
begin
Proc(fieldByName(‘sName’).asString);
next;
end;
finally
qry.Free;
end;
end
else
inherited;
end;
end
else
inherited;

end;

end.

[/code]

Exemplo de uma package no FB3: DateUtils Package

Criando um Packege no Delphi para a Integração
Para integrar o novo editor é necessário criar um novo projeto Package no Delphi e incluir o código do editor.
[code]
// exemplo do projeto do Package (mínimo)
package FireEditores;
{$R *.res}
requires
DesignIDE;
contains
Data.fireStoredProcEditor in ‘Data.fireStoredProcEditor.pas’;
end.

[/code]

Estava precisando de informações sobre uma exceção e o log de erro não dizia nada relevante possível de encontrar onde o problema ocorria.

Já vi vários posts sobre o assunto peguntando como fazer isto. Então não tive outra saída… mãos-a-obra.

(uso Delphi 10.1)

A instância  “Application” possui um evento “application.onException” que permite indicar um método para redirecionar a saída de todas as exceções não tratadas pelo aplicativo.

[code lang=”pascal”]
// preparando o evento no formulário principal
procedure TForm1.DoAppException(sender:TObject; E:Exception);
begin
DoAppExceptionEvent(sender,e,true);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := DoAppException;

end;
[/code]

[code lang=”pascal”]
uses Forms, System.Classes,System.SysUtils,System.RTTI;

// grava o log em disco
procedure ErrorLog(ATexto: string);
var
LArquivo: string;
LTextFile: textfile;
begin
LArquivo := ‘Erros_’ + formatDateTime(‘yyyymmdd’, date) + ‘.log’;
ForceDirectories(ExtractFilePath(LArquivo));

AssignFile(LTextFile, LArquivo);
try
{$I-}
Append(LTextFile);
{$I+}
if IOResult <> 0 then // se o arquivo nao existe, criar um novo;
Rewrite(LTextFile);
WriteLn(LTextFile, ATexto);
finally
CloseFile(LTextFile);
end;
end;

// monta a mensagem do log com base nos atributos do objecto que gerou a exceção
procedure DoAppExceptionEvent(Sender: TObject; E: Exception;
AShow: boolean = True);
var
LMsg: string;
function GetRTTILog(ASender: TObject): string;
var
LNome: string;
LContext: TRttiContext;
LType: TRttiType;
LProp: TRttiProperty;
LVar: TValue;
LTxt: String;
begin
result := ”;
if ASender=nil then exit;
result := ‘ClassName: ‘ + ASender.ClassName + #13#10;
LContext := TRttiContext.Create;
try
LType := LContext.GetType(ASender.ClassType);
for LProp in LType.GetProperties do
begin
try
LVar := LProp.GetValue(ASender);
LTxt := LVar.AsString;
if LTxt <> ” then
result := result + LProp.Name + ‘: ‘ + LTxt + #13#10;
except
end;
end;
finally
LContext.Free;
end;
end;

begin
try
LMsg := ”;
if assigned(Sender) then
begin
LMsg := GetRTTILog(Sender);
end;
LMsg := LMsg + ‘ Message: ‘ + E.Message;
ErrorLog(LMsg);
except
on ee: Exception do
ErrorLog(ee.Message);
end;
if AShow then
begin
E.Message := LMsg;
Application.ShowException(E);
end;
end;

[/code]