delphidebuggingstack-tracejedidelphi-10.2-tokyo

Delphi - Trying to get StackTrace for an exception


I have an exception logger that logs all exceptions to a log file:

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;

To enable the Exception.StackTrace, I am using JCLDebug as outlined in: 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.

I have enabled the following options in Project Options:

Compiling: Debug Information, Local Symbols, Symbol Reference Info, Use debug .dcus, Use imported data references

Linking: Debug Information

However, when I trigger an exception, even though the GetExceptionStackInfoProc gets triggered, the Exception.StackInfo is always an empty string. Any ideas as to what I may be missing?

UPDATE 20170504: Thanks to Stefan Glienke for the solution. For completeness, I am including the code here for the changed GetExceptionStackInfoProc procedure that incorporates his solution:

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;

Solution

  • You need to create it yourself (and free it):

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

    On that instance you can call AddToStrings.

    For more info take a look at JclDebug.GetExceptionStackInfo. The value for AIgnoreLevels is taken from there but in my tests I always had one entry too much so I increased it by one.

    The following it a snippet from what I get from a Button1 application calling 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")