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]