Delphi - Trying to get StackTrace for an exception

Question

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;

score 5 · Accepted Answer · answered May 04 '17 at 08:16

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")

Thank you @stefanglienke - this works! Do you have any recommendations of how I can include this functionality in my deployment (prod) exe while keeping the file size to a minimum (i.e. what are the bare minimum flags to set in project options to get the same output)? — Rohit, May 04 '17 at 09:52

score 2 · Answer 2 · answered Jun 04 '18 at 06:17

2

If you actually read the JclDebug unit, you will see that initialization and finalization sections have registration and deregistration code, so simply placing the unit into the uses section is enough. (See SetupExceptionProcs)

answered Jun 04 '18 at 06:17

nurettin

9,834
5
53
77

Delphi - Trying to get StackTrace for an exception

2 Answers2