CODEWITHSUNDEEP
delphidebuggingstack-tracejedidelphi-10.2-tokyo
Rohit
Rohit

Reputation: 929

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;

Upvotes: 5

Views: 4464

Answers (2)

nurettin
nurettin

Reputation: 11736

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)

Upvotes: 2

Stefan Glienke
Stefan Glienke

Reputation: 21713

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

Upvotes: 6

Related Questions