Koncept výjimek v Delphi je dobře vymyšlen a dokonce jsem kdesi četl, že je částečně patentován, jelikož v době Delphi 1 byl naprosto převratný způsobem zpracování za běhu (nějak to souviselo s efektivním odvíjením zásobníku při výjimce, detaily si nepamatuji a snad se nepletu).
Mimochodem Windows podporují výjimky až od 32bit verzí, tj. Delphi 1, které bylo 16bit mělo výjimky vlastní a až Delphi 2 mapují část výjimek na výjimky Windows.
Od Delphi 1 je základem třída Exception, která byla v Delphi 2009 trochu rozšířena - přece jen je to už pár let.
Pro začátečníky je stručné pojednání o výjimkách v článku pro začátečníky (pravý sloupec), pro ty ostatní: třída byla rozšířena o objekt InnerException a podporu pro StackTrace. Dám sem rovnou ukázku kódu, na formuláři jsou dvě tlačítka a jejich obsluhy.
1unit Unit1;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9type
10 TForm1 = class(TForm)
11 btn1: TButton;
12 btn2: TButton;
13 procedure btn1Click(Sender: TObject);
14 procedure btn2Click(Sender: TObject);
15 private
16
17 procedure mTest;
18 procedure mTest2;
19 public
20
21 e:Exception;
22 end;
23
24var
25 Form1: TForm1;
26
27implementation
28uses
29 JclDebug;
30
31
32procedure TForm1.btn1Click(Sender: TObject);
33begin
34 try
35 mTest;
36 except
37 on E:Exception do
38 ShowMessage(E.ToString);
39 end;
40end;
41
42procedure TForm1.btn2Click(Sender: TObject);
43begin
44 try
45 mTest2;
46 except
47 on E:Exception do
48 begin
49 ShowMessage(E.ToString);
50 if E.InnerException <> nil then
51 ShowMessage(E.InnerException.Message);
52 ShowMessage(E.StackTrace)
53 end;
54 end;
55end;
56
57procedure TForm1.mTest;
58var
59 sl:TStringList;
60begin
61 try
62 sl := TStringList.Create;
63 try
64 raise SysUtils.EProgrammerNotFound.Create('Tady to někdo neudělal dobře.');
65
66 finally
67 sl.Free;
68 end;
69 except
70 on E:Exception do
71 begin
72 E.Message := E.Message + #13#10 + 'Další řádek';
73 raise;
74 end;
75 end;
76end;
77
78type
79 EOwnException =class(Exception);
80
81procedure TForm1.mTest2;
82var
83 sl:TStringList;
84begin
85 try
86 sl := TStringList.Create;
87 try
88 raise SysUtils.EProgrammerNotFound.Create('Tady to někdo neudělal dobře.');
89
90 finally
91 sl.Free;
92 end;
93 except
94 on E:Exception do
95 begin
96 Exception.RaiseOuterException(EOwnException.Create('Nova exception'));
97 end;
98 end;
99end;
100
101
102
103
104function GetExceptionStackInfoProc(P: PExceptionRecord):Pointer;
105begin
106 Result := TJclStackInfoList.Create(False, 0, nil);
107end;
108
109function GetStackInfoStringProc(Info: Pointer):String;
110var
111 Stack:TJclStackInfoList;
112 Str:TStringList;
113begin
114 if Info = nil then Exit;
115 str := nil;
116 try
117 str := TStringList.Create;
118 Stack := TJclStackInfoList(Info);
119 Stack.AddToStrings(Str);
120 Result := Str.Text;
121 finally
122 FreeAndNil(Str);
123 end;
124
125end;
126
127procedure CleanUpStackInfoProc(Info: Pointer);
128begin
129 FreeAndNil(TJclStackInfoList(Info));
130end;
131
132initialization
133 Exception.CleanUpStackInfoProc := CleanUpStackInfoProc;
134 Exception.GetExceptionStackInfoProc := GetExceptionStackInfoProc;
135 Exception.GetStackInfoStringProc := GetStackInfoStringProc;
136end.
mTest a mTest2 jsou dvě ukázky jak při odchycení výjimky modifikovat výjimku. mTest bude fungovat i v Delphi před 2009, druhý způsob používá InnerException, kdy
Exception.RaiseOuterException(EOwnException.Create('Nova exception'));
vyvolá novou výjimku a právě zpracovávaná je přesunutá do InnerException. To samozřejmě lze opakovat a tak jde přes InnerException vybudovat řetěz výjimek (normálně by byla jen dostupná historie volání, ale všechny další informace pak musí být součástí jedné výjimky podobně jako v předchozím případě).
Metoda ToString pak samozřejmě prochází všechny dostupné InnerException.
Druhá nová věc je možnost výpisu zásobníku. Exception nyní obsahuje property StackTrace, která volá rutinu pro získání zásobníku, která se nastavuje přes
Exception = class(TObject)
….
class var
GetExceptionStackInfoProc: function (P: PExceptionRecord): Pointer;
GetStackInfoStringProc: function (Info: Pointer): string;
CleanUpStackInfoProc: procedure (Info: Pointer);
class procedure RaiseOuterException(E: Exception); static;
end;
viz sekce initialization v příkladu.
Uvedené zjišťování používá klasické trasování volání bez použití InnerException z JCL.
RSS