Bonjour

Cherchant une solution simple pour obtenir une stacktrace pour des violations d'accès étranges dans mon soft, j'ai trouvé le site suivant :

https://blog.gurock.com/working-with...on-stacktrace/

J'ai pris l'exemple et je le teste dans un projet identique à celui donné en exemple sauf qu'au moment de l'exception j'envoie le stacktrace dans un memo.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
procedure TForm3.Button1Click(Sender: TObject);
begin
  try
    SomeMethod;
  except
    on E: Exception do
      Memo1.Text := E.StackTrace;
  end;
end;
Je démarre le programme, je clique sur le bouton et ...... rien !
Là, je me dis qu'il y a une incompatibilité avec FMX.

Je relance en pas à pas et j'arrive dans l'unité JclDebug dans la procédure :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
function JclLastExceptStackListToStrings(Strings: TStrings; IncludeModuleName, IncludeAddressOffset,
  IncludeStartProcLineOffset, IncludeVAddress: Boolean): Boolean;
var
  List: TJclStackInfoList;
begin
  List := JclLastExceptStackList;
  Result := Assigned(List);
  if Result then
    List.AddToStrings(Strings, IncludeModuleName, IncludeAddressOffset, IncludeStartProcLineOffset,
      IncludeVAddress);
end;
Je regarde si JclLastExceptStackList est bien renseigné et surprise : non ! Il vaut nil.
Évidemment, pas de retour de la stacktrace.

Je continue l'exécution et je reclique pour déclencher l'exception et là, JclLastExceptStackList n'est plus à nil et je récupère bien la stacktrace attendue qui m'indique la ligne qui a déclenché l'exception.

Ça ne fonctionne donc qu'au second déclenchement d'exception.

D'après vous:
  • j'ai oublié un truc ?
  • L'auteur du tuto a oublié un truc ?
  • Ou Quelque chose manque dans JclDebug ?


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
unit Unit3;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.ScrollBox, FMX.Memo, StackTrace;
 
type
  TForm3 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    procedure SomeMethod;
  public
    { Déclarations publiques }
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.fmx}
 
{ TForm3 }
 
procedure TForm3.Button1Click(Sender: TObject);
begin
  try
    SomeMethod;
  except
    on E: Exception do
      Memo1.Text := E.StackTrace;
  end;
end;
 
procedure TForm3.SomeMethod;
begin
  raise Exception.Create('A test exception');
end;
 
end.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
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.