Share Button

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…


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.

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.

// exemplo do projeto do Package (mínimo)
package FireEditores;
{$R *.res}
requires
  DesignIDE;
contains
  Data.fireStoredProcEditor in 'Data.fireStoredProcEditor.pas';
end.

Share Button

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.

// 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;
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;