Новый класс Exception в Delphi 2009 и выше

Начиная с Delphi 2009, класс Exception, который был неизменным с самого первого выпуска Delphi, получил новые поля и свойства. А значит - и новые возможности. Поэтому, я хотел бы сделать обзор новых возможностей и показать, как их можно использовать.

Итак, раньше Exception был очень простым объектом всего с двумя свойствами:

type
  Exception = class(TObject)
  // ...
  public
    // Все конструкторы ниже представляют собой просто
    // разные варианты заполнения свойств FMessage и FHelpContext 
    constructor Create(const Msg: string);
    // ...
    property HelpContext: Integer read FHelpContext write FHelpContext;
    property Message: string read FMessage write FMessage;
  end;

По сути, нам доступно только текстовое описание исключения (HelpContext, который должен содержать ID темы в справке, на практике не используется). Разумеется, мы можем объявить свой пользовательский класс, в котором мы можем добавить какие угодно свойства, но разве не было бы замечательно, если бы штатные исключения предоставляли бы чуть больше возможностей? Например, информацию о предыдущем исключении?

Так или иначе, но в Delphi 2009 класс Exception был (наконец-то!) расширен и обзавёлся такими свойствами:

type
  Exception = class(TObject)
  // ...
  protected
    procedure SetInnerException;
    procedure SetStackInfo(AStackInfo: Pointer);
    function GetStackTrace: string;
    procedure RaisingException(P: PExceptionRecord); virtual;
  public
    constructor Create(const Msg: string);
    // ...
    function GetBaseException: Exception; virtual;
    function ToString: string; override;
    property BaseException: Exception read GetBaseException;
    property HelpContext: Integer read FHelpContext write FHelpContext;
    property InnerException: Exception read FInnerException;
    property Message: string read FMessage write FMessage;
    property StackTrace: string read GetStackTrace;
    property StackInfo: Pointer read FStackInfo;
  class var
    GetExceptionStackInfoProc: function (P: PExceptionRecord): Pointer;
    GetStackInfoStringProc: function (Info: Pointer): string;
    CleanUpStackInfoProc: procedure (Info: Pointer);
    class procedure RaiseOuterException(E: Exception); static;
    class procedure ThrowOuterException(E: Exception); static;
  end;

Все новые свойства принадлежат одной из двух новых возможностей:

• Поддержке вложенных исключений
• Поддержке диагностики исключений

Давайте разберёмся с ними по очереди.

Вложенные исключения

Вложенное исключение (его ещё называют chained-исключение) - это ситуация, когда у вас возникает новое исключение в момент обработки какого-либо исключения (в блоках finally или except). Если у вас нет поддержки вложенных исключений (как в Delphi до 2009), то вы теряете исходное исключение, оставляя только самое последнее. Иногда, это то, что вы хотите сделать, иногда - нет.

Два примера. Первый:

procedure TSomeClass.SaveToStream(const AStream: Stream);
begin
  try
    // ... тут действия по сохранению экземпляра в поток
  except
    raise ESomeClassSaveError.Create('Ошибка сохранения в поток');
  end;
end;

Мне кажется, что пример достаточно прозрачен. Мы генерируем ошибку верхнего уровня (ESomeClassSaveError) по ошибке низкого уровня (это может быть тривиальный EStreamError из-за нехватки места или же index out of range из-за повреждений внутреннего состояния объекта). В любом случае, пользователь получит доступное описание ситуации - что и было нашей целью. Обратите внимание, что информация о исходной проблеме утеряна. Исключение более высокого уровня скрыло предыдущее. В этом случае мы возбудили исключение сами, намеренно. В следующем примере это будет неожиданно.

Пример два:

SomeClass := TSomeClass.Create;
  try
    // ... тут работа с SomeClass, пусть мы возбуждаем исключение (например, EAbort)
  finally
    FreeAndNil(SomeClass); // деструктор SomeClass возбуждает исключение
  end;

В данном примере, мы уже ничего не планируем. У нас появляется второе исключение в деструкторе (что есть плохая практика). Это какой-то тривиальный access violation из-за того, что мы не ожидали каких-либо условий. Хотя в этом случае второе исключение тоже скрывает первое, но ценная информация может теряться, а может и нет - смотря по тому, в чём же конкретно был баг в этой ситуации.

В любом случае, в обоих примерах происходит утечка ценной информации, которая могла бы дать подсказку при диагностике проблемы. Вот тут на сцену и выходит поддержка вложенных исключений.

В новом классе Exception (да уж, это заняло немало времени, но надо же было потратить его на введение во вложенные исключения - многие просто не знакомы с этим понятием) у нас появились свойства InnerException и BaseException. Оба эти свойства устанавливаются (управляются) автоматически модулем SysUtils. Вы можете их читать и использовать. InnerException предоставляет вам вложенное исключение. BaseException - самое первое исключение, с которого и началась цепочка исключений. Если исключений в цепочке два, то InnerException равно BaseException. Если исключение всего одно, то оба свойства равны nil.

По-умолчанию, вложенные исключения не запоминаются. Чтобы сохранить вложенное исключение, вам нужно возбудить его через Exception.RaiseOuterException (стиль Delphi) или Exception.ThrowOuterException (стиль C++ Builder). Например:

procedure TSomeClass.SaveToStream(const AStream: Stream);
begin
  try
    // ... тут действия по сохранению экземпляра в поток
  except
    Exception.RaiseOuterException(ESomeClassSaveError.Create('Ошибка сохранения в поток'));
  end;
end;

После выполнения этого примера мы получим исключение класса ESomeClassSaveError, у которого в InnerException будет сидеть конкретная ошибка сохранения в поток (EStreamError или что там у нас было).

Во втором примере (с деструктором) - поскольку RaiseOuterException не используется, то InnerException будет nil.

Как связана поддержка вложенных исключений с показом сообщений? Ну, свойство Message неизменно - это свойство только текущего исключения. Поэтому, любой код, который не в курсе про вложенные исключения, будет показывать только сообщение (единственное) для последнего исключения. А вот метод ToString класса Exception покажет вам всю цепочку вызовов - по исключению на строчку (понятно, что в случае единственного исключения, ToString равно Message). С другой стороны, несколько странно выглядит показ сообщения в Application.ShowException: этот метод показывает сообщение от BaseException - вероятно, это не то, что вы бы хотели (в нашем примере выше мы хотели показать 'Ошибка сохранения в поток'). Поэтому, я подозреваю, что вы захотите сделать свой обработчик Application.OnException, чтобы изменить это поведение. Например:

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
var
  Msg: String;
begin
  Msg := E.Message; // или E.ToString
  Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_OK + MB_ICONSTOP);
end;

Далее, лично мне не очень понятно, почему разработчики Delphi не сделали авто-захват вложенных исключений во всех случаях.

[Обновлено 2019.10.22]: Пример ниже не будет работать корректно в случае если в вашей программе есть блоки try внутри блоков finally/except, см. обсуждение ниже.

Если вы хотите сделать авто-захват вложенных исключений во всех случаях, то вам нужно подключить к вашей программе такой модуль (внимание: это хак; подробнее о внутреннем механизме InnerException можно почитать тут):

unit ChainedExceptionsAlways;

interface

implementation

uses
  SysUtils;

var
  OldRaiseExceptObject: Pointer;

type
  EExceptionHack = class
  public
    FMessage: string;
    FHelpContext: Integer;
    FInnerException: Exception;
    FStackInfo: Pointer;
    FAcquireInnerException: Boolean;
  end;

procedure RaiseExceptObject(P: PExceptionRecord);
type
  TRaiseExceptObjectProc = procedure(P: PExceptionRecord);
begin
  if TObject(P^.ExceptObject) is Exception then
    EExceptionHack(P^.ExceptObject).FAcquireInnerException := True;

  if Assigned(OldRaiseExceptObject) then
    TRaiseExceptObjectProc(OldRaiseExceptObject)(P);
end;

initialization
  OldRaiseExceptObject := RaiseExceptObjProc;
  RaiseExceptObjProc := @RaiseExceptObject;
end.

После подключения этого модуля наш второй пример также станет собирать InnerException, а в первом примере можно будет использовать как Exception.RaiseOuterException, так и просто raise.

Диагностика исключений

Ну, если вы читаете мой блог, то с понятием диагностики исключений и стека вызовов вы должны быть уже знакомы, поэтому я пропущу введение. С другой стороны, чтобы показать место/цель нововведений класса Exception, я кратко опишу архитектуру трейсеров исключений с самого начала.

Программа - это набор машинных команд, т.е. чисел. По-умолчанию, в программе нет никакого текста программы. Поэтому, построить стек штатными средствами - невозможно. И нужно использовать стороннее решение, которое делает следующее:

• Добавляет в скомпилированный модуль отладочную информацию (соответствие машинных инструкций тексту программы) в общеизвестном или приватном формате. Чаще всего, она добавляется как ресурс RC_DATA или секция PE.
• Устанавливает hook на возникновение исключений (на какую-либо функцию, которая вызывается всегда при возникновении исключений. Например, RaiseException из Kernel32). Обычно это патчинг чего-либо (таблицы импорта или секции кода).
• В ловушке исключений строит стек, используя какой-либо алгоритм трассировки стека, вручную проходясь по машинному стеку и вылавливая из него адреса вызовов функций. Вы также можете использовать Майкросовтовский Debug Help API.

Если первый и последний пункт представляют собой красивое и документированное решение, то пункт два - это грязные хаки. Поэтому, чтобы упростить нам жизнь, разработчики Delphi добавили архитектуру поддержки трейсеров исключений (немного поздно, но всё же лучше поздно, чем никогда). Всё, что она делает - позволяет вам вызвать свою процедуру в момент возникновения исключения, убирая необходимость в ручном патчинге. Ничего больше она не делает. Иными словами, никакого стека вызовов "из коробки" вы не получите.

Ещё раз: это возможность предназначена для разработчиков трейсеров исключений. Есть подозрение, что она была добавлена в Delphi в преддверие перехода на Mac OS и Linux с целью унификации кода.

Поскольку уже написанные трейсеры исключений не используют эту возможность (да и не могут её использовать, потому что они работают и в тех версиях Delphi, где её нет), то вам надо использовать их возможности по получению стека вызовов. Например, для JCL это будет вызов JclLastExceptStackList, а для EurekaLog - GetLastExceptionCallStack.

Однако, вы можете интегрировать любой существующий трейсер (или написать свой) в эту новую архитектуру. Если написание своего - это достаточно сложная задача, то интегрировать уже существующий - это дело пары минут. Если при этом трейсер чётко состоит из нескольких частей, то, интегрировав его в эту архитектуру, вы можете не подключать ту его часть, которая ответственна за хуки.

Итак, если вы решили, что вам это надо, то вот краткое описание с примером для джедаев и EurekaLog.

Во-первых, надо понимать, что вышеуказанная поддержка касается двух модулей - System и SysUtils. Как и с другими возможностями по исключениям, весь базовый функционал заключён в модуле System. Модуль SysUtils является лишь удобной обёрткой к System. Для этого System выставляет наружу некоторые события (ExceptProc, ErrorProc, ExceptClsProc, ExceptObjProc, RaiseExceptionProc, RTLUnwindProc, RaiseExceptObjProc, ExceptionAcquired, ExceptionClass, SafeCallErrorProc, AssertErrorProc и AbstractErrorProc), которые и использует модуль SysUtils. Вам не следует использовать их напрямую, если только вы не отказались от модуля SysUtils. Вместо использования событий модуля System, вы используете модуль SysUtils. Более подробно события модуля System рассматриваются тут (пункт 10, обсуждение модуля System).

Итак, что же тогда нам предлагает модуль SysUtils? А модуль SysUtils предлагает нам новый класс Exception, в котором появились события GetExceptionStackInfoProc, GetStackInfoStringProc и CleanUpStackInfoProc. По-умолчанию, они не назначены - да и их некому реализовывать, т.к., как я уже сказал, в программе по-умолчанию просто нет информации для этого.

Значит, нам надо их реализовать. Поскольку мы пишем просто обёртку к уже существующему трейсеру, то всё, что нам надо будет сделать - вызвать подходящую функцию трейсера. Например:

unit ExceptionJCLSupport;

interface

implementation

uses
  SysUtils, Classes, JclDebug;

function GetExceptionStackInfoJCL(P: PExceptionRecord): Pointer;
const
  cDelphiException = $0EEDFADE;
var
  Stack: TJclStackInfoList;
  Str: TStringList;
  Trace: String;
  Sz: Integer;
begin
  if P^.ExceptionCode = cDelphiException then
    Stack := JclCreateStackList(False, 3, P^.ExceptAddr)
  else
    Stack := JclCreateStackList(False, 3, P^.ExceptionAddress);
  try
    Str := TStringList.Create;
    try
      Stack.AddToStrings(Str, True, True, True, True);
      Trace := Str.Text;
    finally
      FreeAndNil(Str);
    end;
  finally
    FreeAndNil(Stack);
  end;

  if Trace <> '' then
  begin
    Sz := (Length(Trace) + 1) * SizeOf(Char);
    GetMem(Result, Sz);
    Move(Pointer(Trace)^, Result^, Sz);
  end
  else
    Result := nil;
end;

function GetStackInfoStringJCL(Info: Pointer): string;
begin
  Result := PChar(Info);
end;

procedure CleanUpStackInfoJCL(Info: Pointer);
begin
  FreeMem(Info);
end;

initialization
  Exception.GetExceptionStackInfoProc := GetExceptionStackInfoJCL;
  Exception.GetStackInfoStringProc := GetStackInfoStringJCL;
  Exception.CleanUpStackInfoProc := CleanUpStackInfoJCL;
end.

Достаточно добавить этот модуль в uses (чем раньше - тем лучше) и вы волшебным образом получаете свой стек:

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
var
  Msg, Stack: String;
  Inner: Exception;
begin
  Inner := E;
  Msg := '';
  while Inner <> nil do
  begin
    if Msg <> '' then
      Msg := Msg + sLineBreak;
    Msg := Msg + Inner.Message;
    if (Msg <> '') and (Msg[Length(Msg)] > '.') then
      Msg := Msg + '.';

    Stack := Inner.StackTrace;
    if Stack <> '' then
    begin
      if Msg <> '' then
        Msg := Msg + sLineBreak + sLineBreak;
      Msg := Msg + Stack + sLineBreak;
    end;

    Inner := Inner.InnerException;
  end;
  Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_OK + MB_ICONSTOP);
end;

Для кода:

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    PInteger(nil)^ := 0;
  except
    raise Exception.Create('Error occured');
  end;
end;

Пример вывода будет (с вложенными исключениями):

Error occured.

(000A7D0F){Project68.exe} [004A8D0F] Unit1.TForm1.Button1Click (Line 61, "Unit1.pas" + 4) + $16
(00004901){Project68.exe} [00405901] System.@RaiseExcept (Line 12194, "System.pas" + 47) + $0
(00076473){Project68.exe} [00477473] Controls.TControl.Click (Line 7178, "Controls.pas" + 9) + $8
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0007A91F){Project68.exe} [0047B91F] Controls.DoControlMsg (Line 9888, "Controls.pas" + 12) + $11
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(0009AC94){Project68.exe} [0049BC94] Forms.TCustomForm.WndProc (Line 3960, "Forms.pas" + 191) + $5
(00079E6C){Project68.exe} [0047AE6C] Controls.TWinControl.MainWndProc (Line 9540, "Controls.pas" + 3) + $6
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0
(0007A8CC){Project68.exe} [0047B8CC] Controls.TWinControl.DefaultHandler (Line 9860, "Controls.pas" + 30) + $17
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0


Access violation at address 004A8CE8 in module 'Project1.exe'. Write of address 00000000.

(000A7CE8){Project68.exe} [004A8CE8] Unit1.TForm1.Button1Click (Line 59, "Unit1.pas" + 2) + $4
(0000453F){Project68.exe} [0040553F] System.@HandleAnyException (Line 11245, "System.pas" + 13) + $0
(00076473){Project68.exe} [00477473] Controls.TControl.Click (Line 7178, "Controls.pas" + 9) + $8
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0007A91F){Project68.exe} [0047B91F] Controls.DoControlMsg (Line 9888, "Controls.pas" + 12) + $11
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(0009AC94){Project68.exe} [0049BC94] Forms.TCustomForm.WndProc (Line 3960, "Forms.pas" + 191) + $5
(00079E6C){Project68.exe} [0047AE6C] Controls.TWinControl.MainWndProc (Line 9540, "Controls.pas" + 3) + $6
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0
(0007A8CC){Project68.exe} [0047B8CC] Controls.TWinControl.DefaultHandler (Line 9860, "Controls.pas" + 30) + $17
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0

Обратите внимание, что в этом примере не используется хукинг исключений средствами JCL (JclHookExcept). Всё работает и без него. Мы используем только возможности JCL по чтению отладочной информации и трасировке стека.

Аналогичный модуль для EurekaLog (применимо для EurekaLog 6 и ниже; EurekaLog 7 и выше уже интегрируется с новым классом Exception):

unit ExceptionEurekaLogSupport;

interface

implementation

uses
  SysUtils, Classes, ExceptionLog;

function GetExceptionStackInfoEurekaLog(P: PExceptionRecord): Pointer;
const
  cDelphiException = $0EEDFADE;
var
  Stack: TEurekaStackList;
  Str: TStringList;
  Trace: String;
  Sz: Integer;
  DI: PEurekaDebugInfo;
begin
  Stack := GetCurrentCallStack;
  try
    New(DI);
    DI^.ModuleInfo := ModuleInfoByAddr(Cardinal(P^.ExceptAddr));
    if P^.ExceptionCode = cDelphiException then
      GetSourceInfoByAddr(Cardinal(P^.ExceptAddr), DI)
    else
      GetSourceInfoByAddr(Cardinal(P^.ExceptionAddress), DI);
    Stack.Insert(0, DI);

    Str := TStringList.Create;
    try
      CallStackToStrings(Stack, Str);
      Trace := Str.Text;
    finally
      FreeAndNil(Str);
    end;
  finally
    FreeAndNil(Stack);
  end;

  if Trace <> '' then
  begin
    Sz := (Length(Trace) + 1) * SizeOf(Char);
    GetMem(Result, Sz);
    Move(Pointer(Trace)^, Result^, Sz);
  end
  else
    Result := nil;
end;

function GetStackInfoStringEurekaLog(Info: Pointer): string;
begin
  Result := PChar(Info);
end;

procedure CleanUpStackInfoEurekaLog(Info: Pointer);
begin
  FreeMem(Info);
end;

initialization
  Exception.GetExceptionStackInfoProc := GetExceptionStackInfoEurekaLog;
  Exception.GetStackInfoStringProc := GetStackInfoStringEurekaLog;
  Exception.CleanUpStackInfoProc := CleanUpStackInfoEurekaLog;
end.

Вариант модуля для madExcept я оставляю вам в качестве домашнего задания ;)

Читать далее: Фреймы на стеке (стековые фреймы).