function GetExceptionStackInfoProc(P: System.PExceptionRecord): Pointer;
var
LLines: TStringList;
LText:
String;
LResult: PChar;
jcl_sil: TJclStackInfoList;
begin
LLines := TStringList.Create;
try
{$IFDEF WIN64}
jcl_sil := TJclStackInfoList.Create(true, 10, p.ExceptionAddress, false,
nil,
nil);
{$ENDIF}
{$IFDEF WIN32}
jcl_sil := TJclStackInfoList.Create(true, 32, p.ExceptionAddress, false,
nil,
nil);
{$ENDIF}
try
jcl_sil.AddToStrings(LLines);
finally
FreeAndNil(jcl_sil);
end;
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
if JclStartExceptionTracking
then
begin
Exception.GetExceptionStackInfoProc := GetExceptionStackInfoProc;
Exception.GetStackInfoStringProc := GetStackInfoStringProc;
Exception.CleanUpStackInfoProc := CleanUpStackInfoProc;
end;
finalization
if JclExceptionTrackingActive
then
begin
Exception.GetExceptionStackInfoProc :=
nil;
Exception.GetStackInfoStringProc :=
nil;
Exception.CleanUpStackInfoProc :=
nil;
JclStopExceptionTracking;
end;
end.