Delphi - Der Versuch, Stacktrace für eine Ausnahme

Question

Ich habe eine Ausnahme Logger zu erhalten, die alle Ausnahmen in einer Protokolldatei protokolliert:

class function TLogger.LogException (ACaller: String; E: Exception): Boolean; 
var 
    LogFilename, tmp: string; 
    LogFile: TextFile; 
    appsettings: TApplicationSettings; 
begin 
    // prepare log file 
    appsettings:=TApplicationSettings.Create; 
    try 
    tmp:=appsettings.ErrorLogsLocation; 
    finally 
    FreeAndNil(appsettings); 
    end; 

    if NOT (DirectoryExists(tmp)) then 
    CreateDir(tmp); 
    //We create a new log file for every day to help with file size issues 
    LogFilename:=IncludeTrailingPathDelimiter (tmp) + 'LJErrors_' + FormatDateTime('yyyy-mm-dd', Now) +'.log'; 

    try 
    AssignFile (LogFile, LogFilename); 
    if FileExists (LogFilename) then 
     Append (LogFile) // open existing file 
    else 
     Rewrite (LogFile); // create a new one 

    // write to the file and show error 
    Writeln(LogFile, CRLF+CRLF); 
    Writeln (LogFile, 'Application Path: ' + ExtractFilePath(ParamStr (0))); 
    Writeln (LogFile, 'Application Version: ' + TUtility.GetAppVersionString); 
    Writeln (LogFile, 'Operating System: ' + TUtility.GetOSInfo); 
    Writeln (LogFile, 'Error occurred at: ' + FormatDateTime ('dd-mmm-yyyy hh:nn:ss AM/PM', Now)); 
    Writeln (LogFile, 'Logged By: ' + ACaller); 
    Writeln (LogFile, 'Unit Name: ' + E.UnitName); 
    Writeln (LogFile, 'Error Message: ' + E.Message); 
    Writeln (LogFile, 'Error Class: ' + E.ClassName); 
    Writeln (LogFile, 'Base Exception Error: ' + E.BaseException.Message); 
    Writeln (LogFile, 'Base Exception Class: ' + E.BaseException.ClassName); 
    Writeln (LogFile, 'Stack Trace: ' + E.StackTrace); 
    Result:=True; 
    finally 
    // close the file 
    CloseFile (LogFile); 
    end; 
end; 

die Exception.StackTrace zu aktivieren, ich bin mit JCLDebug wie in skizziert: https://blog.gurock.com/working-with-delphis-new-exception-stacktrace.

unit StackTrace; 

interface 

uses 
    SysUtils, Classes, JclDebug; 

implementation 

function GetExceptionStackInfoProc(P: PExceptionRecord): Pointer; 
var 
    LLines: TStringList; 
    LText: String; 
    LResult: PChar; 
begin 
    LLines := TStringList.Create; 
    try 
    JclLastExceptStackListToStrings(LLines, True, True, True, True); 
    LText := LLines.Text; 
    LResult := StrAlloc(Length(LText)); 
    StrCopy(LResult, PChar(LText)); 
    Result := LResult; 
    finally 
    LLines.Free; 
    end; 
end; 

function GetStackInfoStringProc(Info: Pointer): string; 
begin 
    Result := string(PChar(Info)); 
end; 

procedure CleanUpStackInfoProc(Info: Pointer); 
begin 
    StrDispose(PChar(Info)); 
end; 

initialization 
// Start the Jcl exception tracking and register our Exception 
// stack trace provider. 
if JclStartExceptionTracking then 
begin 
    Exception.GetExceptionStackInfoProc := GetExceptionStackInfoProc; 
    Exception.GetStackInfoStringProc := GetStackInfoStringProc; 
    Exception.CleanUpStackInfoProc := CleanUpStackInfoProc; 
end; 

finalization 
// Stop Jcl exception tracking and unregister our provider. 
if JclExceptionTrackingActive then 
begin 
    Exception.GetExceptionStackInfoProc := nil; 
    Exception.GetStackInfoStringProc := nil; 
    Exception.CleanUpStackInfoProc := nil; 
    JclStopExceptionTracking; 
end; 

end. 

ich die folgenden Optionen im Projektoptionen aktiviert haben:

compilieren: Debug Informationen, lokale Symbole, Symbol Referenz Info, Sie mit debug .dcus, Verwenden Referenzen auf importierte Daten

Linking : Debug Information

Wenn ich jedoch eine Ausnahme auslösen, obwohl die GetExceptionStackInfoProc ausgelöst wird, die Exception.StackInfo ist immer eine leere Zeichenfolge. Irgendwelche Ideen, was ich vermisse?

UPDATE 20170504: Danke an Stefan Glienke für die Lösung. Für Vollständigkeit, bin auch ich hier den Code für das geändert GetExceptionStackInfoProc Verfahren, das seine Lösung beinhaltet:

function GetExceptionStackInfoProc(P: PExceptionRecord): Pointer; 
var 
    LLines: TStringList; 
    LText: String; 
    LResult: PChar; 
    jcl_sil: TJclStackInfoList; 
begin 
    LLines := TStringList.Create; 
    try 
    jcl_sil:=TJclStackInfoList.Create(True, 7, p.ExceptAddr, False, nil, nil); 
    try 
     jcl_sil.AddToStrings(LLines, true, true, true, true); 
    finally 
     FreeAndNil(jcl_sil); 
    end; 
    LText := LLines.Text; 
    LResult := StrAlloc(Length(LText)); 
    StrCopy(LResult, PChar(LText)); 
    Result := LResult; 
    finally 
    LLines.Free; 
    end; 
end; 

Answer 1

Sie es brauchen selbst zu erstellen (und kostenlos es):

TJclStackInfoList.Create(True, 7, p.ExceptAddr, False, nil, nil); 

An diesem Beispiel können Sie Anruf AddToStrings.

Für weitere Informationen werfen Sie einen Blick auf JclDebug.GetExceptionStackInfo. Der Wert für AIgnoreLevels wird von dort genommen, aber in meinen Tests hatte ich immer einen Eintrag zu viel, also erhöhte ich ihn um eins.

Das folgende ist ein Ausschnitt aus dem, was ich von einer Anwendung Button1 abrufen RaiseLastOSError;

[0042BFE5] System.SysUtils.Sysutils.RaiseLastOSError$qqrix20System.UnicodeString (Line 24937, "System.SysUtils.pas") 
[0042BF5B] System.SysUtils.Sysutils.RaiseLastOSError$qqrv (Line 24919, "System.SysUtils.pas") 
[005CD004] Unit85.TForm85.Button1Click$qqrp14System.TObject (Line 28, "Unit85.pas") 
[0051D567] Vcl.Controls.TControl.Click$qqrv (Line 7429, "Vcl.Controls.pas") 
[00534CDA] Vcl.StdCtrls.Stdctrls.TCustomButton.Click$qqrv (Line 5434, "Vcl.StdCtrls.pas")