Delphi - 试图获取 StackTrace 的异常

Question

我有一个异常记录器，可将所有异常记录到日志文件中：

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;

要启用Exception.StackTrace，我正在使用JCLDebug，如下所述：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.

我在项目选项中启用了以下选项：

编译：调试信息、本地符号、符号引用信息、使用调试.dcus、使用导入的数据引用

链接：调试信息

但是，当我触发异常时，即使GetExceptionStackInfoProc 被触发，Exception.StackInfo 始终是一个空字符串。关于我可能缺少什么的任何想法？

更新 20170504：感谢 Stefan Glienke 提供的解决方案。为了完整起见，我在此处包含更改后的 GetExceptionStackInfoProc 过程的代码，该过程包含他的解决方案：

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

您需要自己创建它（并释放它）：

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

在该实例上，您可以调用AddToStrings。

欲了解更多信息，请查看JclDebug.GetExceptionStackInfo。 AIgnoreLevels 的值取自那里，但在我的测试中，我总是有一个条目太多，所以我将它增加了一个。

下面是我从一个调用 RaiseLastOSError 的 Button1 应用程序中得到的一个 sn-p；

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

Answer 2

如果你真的读过JclDebug unit，你会看到初始化和终结部分都有注册和注销代码，所以只需将单元放入使用部分就足够了。 （见SetupExceptionProcs）