Почему в D2010 свойство StackTrace пустое?

Сабж?

Вот такой вот тестовый пример сделал...

unit ExcptionsTestMainFrm;
 
interface
 
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
 
type
  TfrmExcptionsTestMain = class( TForm )
    btnDivideByZero: TButton;
    memLog: TMemo;
    btnClearLog: TButton;
    btnOutofMem: TButton;
    btnOutofMem2: TButton;
    procedure btnClearLogClick( Sender: TObject );
    procedure btnDivideByZeroClick( Sender: TObject );
    procedure btnOutofMemClick(Sender: TObject);
    procedure btnOutofMem2Click(Sender: TObject);
    private
      procedure DividingByZero( );
      procedure OutOfMemory( );
      procedure OutOfMemory2();
    public
  end;
 
var
  frmExcptionsTestMain: TfrmExcptionsTestMain;
 
implementation
 
{$R *.dfm}
 
procedure TfrmExcptionsTestMain.btnClearLogClick( Sender: TObject );
begin
  memLog.Clear( );
end;
 
procedure TfrmExcptionsTestMain.btnDivideByZeroClick( Sender: TObject );
begin
  memLog.Lines.Add( '***' );
  memLog.Lines.Add( 'Деление на 0' );
  try
    DividingByZero( );
  except
    on e: Exception do
      begin
        memLog.Lines.Add( '== e.Message' );
        memLog.Lines.Add( e.Message );
        memLog.Lines.Add( '== e.ToString()' );
        memLog.Lines.Add( e.ToString() );
        memLog.Lines.Add( '== e.StackTrace' );
        memLog.Lines.Add( e.StackTrace );
        memLog.Lines.Add( '==' );
        memLog.Lines.Add( '' );
      end;
  end;
end;
 
procedure TfrmExcptionsTestMain.btnOutofMem2Click(Sender: TObject);
begin
  memLog.Lines.Add( '***' );
  memLog.Lines.Add( 'Недостаточно памяти 2 (Деление на 0)' );
  try
    OutOfMemory2( );
  except
    on e: Exception do
      begin
        memLog.Lines.Add( '== e.Message' );
        memLog.Lines.Add( e.Message );
        memLog.Lines.Add( '== e.ToString()' );
        memLog.Lines.Add( e.ToString() );
        memLog.Lines.Add( '== e.StackTrace' );
        memLog.Lines.Add( e.StackTrace );
        memLog.Lines.Add( '==' );
        memLog.Lines.Add( '' );
      end;
  end;
end;
 
procedure TfrmExcptionsTestMain.btnOutofMemClick(Sender: TObject);
begin
  memLog.Lines.Add( '***' );
  memLog.Lines.Add( 'Недостаточно памяти (Деление на 0)' );
  try
    OutOfMemory( );
  except
    on e: Exception do
      begin
        memLog.Lines.Add( '== e.Message' );
        memLog.Lines.Add( e.Message );
        memLog.Lines.Add( '== e.ToString()' );
        memLog.Lines.Add( e.ToString() );
        memLog.Lines.Add( '== e.StackTrace' );
        memLog.Lines.Add( e.StackTrace );
        memLog.Lines.Add( '==' );
        memLog.Lines.Add( '' );
      end;
  end;
end;
 
procedure TfrmExcptionsTestMain.DividingByZero;
begin
  raise EDivByZero.Create( EDivByZero.ClassName );
end;
 
procedure TfrmExcptionsTestMain.OutOfMemory;
begin
  try
    DividingByZero();
  except
    raise EOutOfMemory.Create( EOutOfMemory.ClassName );
  end;
end;
 
procedure TfrmExcptionsTestMain.OutOfMemory2;
begin
  try
    DividingByZero();
  except
    Exception.RaiseOuterException( EOutOfMemory.Create( EOutOfMemory.ClassName ) );
  end;
end;
 
end.

Как и положено в первом случае для аутофмемори никаких внутренних сключений нет... а во стором есть... А вот как добыть стэктрейс?

В Delphi есть поддержка стека вызовов, но нет самого механизма. Т.е. это просто архитектура поддержки для сторонних решений. Потому что нельзя сделать общее решение.

Для того, чтобы стек вызовов появился, вам нужно встроить какой-либо механизм. JCL, EurekaLog, madExcept, etc.

Делается это установкой событий-обработчиков класса Exception.

Добавлено 23.04.10, 12:07
А конкретно: Exception.GetExceptionStackInfoProc, Exception.GetStackInfoStringProc, Exception.CleanUpStackInfoProc.

Что-то я не понял, а где взять эти обработчики?
Их надо самому писать? (Есть ли пример какой-нибудь?)
Или они где-то уже есть их надо просто подключить? (Где искать?)

Добавлено 26.04.10, 16:02
Собственно вот цитата из пункта 1.2.4 твоей статьи:

Цитата

ц). (только D2009 и выше) RaiseExceptObjProc: Pointer; // procedure(P: PExceptionRecord);
Хук возбуждения исключений. Вызывается непосредственно перед вызовом
RaiseExceptionProc. По-умолчанию равен nil. Модуль SysUtils устанавливает такой
обработчик (вызывает уведомление RaisingException, которое создаёт стек вызовов и
сохраняет вложенное исключение):
procedure RaiseExceptObject(P: PExceptionRecord);
begin
if TObject(P.ExceptObject) is Exception then
Exception(P.ExceptObject).RaisingException(P);
end;

Я правильно понимаю, что SysUtils устанавливает обработчик, который должен создать стек? Или это не тот стек? Или он не ставит?

Добавлено 26.04.10, 16:12
И еще, в догонку...

Как в своей процедуре, которой можно заместить RaiseExceptObjProc, можно установить FAcquireInnerException, если это поле private?

Че-то каша какая-то у меня получается...

Сообщение отредактировано: Felan - 26.04.10, 16:14

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

Нужно использовать стороннее решение, которое делает следующее:

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

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

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

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

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

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

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

Итак, что же тогда нам предлагает модуль 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: String;
  SubE: Exception;
begin
  Msg := E.Message;
  while True do
  begin
    SubE := E.GetBaseException;
    if SubE <> E then
    begin
      E := SubE;
      if E.Message <> '' then
        Msg := E.Message;
    end
    else
      Break;
  end;
  if (Msg <> '') and (Msg[Length(Msg)] > '.') then
    Msg := Msg + '.';
  if E.StackTrace <> '' then
    Msg := Msg + sLineBreak + sLineBreak + E.StackTrace;
  Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_OK + MB_ICONSTOP);
end;

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

Аналогичный модуль для EurekaLog:

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.

Цитата Felan @ 26.04.10, 15:50

Как в своей процедуре, которой можно заместить RaiseExceptObjProc, можно установить FAcquireInnerException, если это поле private?

AcquireInnerException нельзя менять самому - только хаками. Понятия не имею, зачем это было сделано. Например:

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.

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

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
var
  Msg: String;
  SubE: Exception;
begin
  Msg := E.Message;
  if (Msg <> '') and (Msg[Length(Msg)] > '.') then
    Msg := Msg + '.';
  if E.StackTrace <> '' then
    Msg := Msg + sLineBreak + sLineBreak + E.StackTrace;
  while True do
  begin
    SubE := E.GetBaseException;
    if SubE <> E then
    begin
      E := SubE;
      if E.Message <> '' then
      begin
        Msg := Msg + sLineBreak + sLineBreak + E.Message;
        if (Msg <> '') and (Msg[Length(Msg)] > '.') then
          Msg := Msg + '.';
        if E.StackTrace <> '' then
          Msg := Msg + sLineBreak + sLineBreak + E.StackTrace;
      end;
    end
    else
      Break;
  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;

покажет (с подключенным ExceptionJCLSupport):

Error occured.
 
(000A7DB7){Project68.exe} [004A8DB7] Unit67.TForm67.Button1Click (Line 64, "Unit67.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 004A8D90 in module 'Project68.exe'. Write of address 00000000.
 
(000A7D90){Project68.exe} [004A8D90] Unit67.TForm67.Button1Click (Line 62, "Unit67.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

Сообщение отредактировано: CodeMonkey - 26.04.10, 19:53

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

Странно.

Сделал вроде по написанному.

Добавил модуль ExceptionJCLSupport, включил отладочую информацию...

Далее для кнопки (из самого первого листинга, только модуль добавил):

procedure TfrmExcptionsTestMain.btnDivideByZeroClick( Sender: TObject );
begin
  memLog.Lines.Add( '***' );
  memLog.Lines.Add( 'Деление на 0' );
  try
    DividingByZero( );
  except
    on e: Exception do
      begin
        memLog.Lines.Add( '== e.Message' );
        memLog.Lines.Add( e.Message );
        memLog.Lines.Add( '== e.ToString()' );
        memLog.Lines.Add( e.ToString() );
        memLog.Lines.Add( '== e.StackTrace' );
        memLog.Lines.Add( e.StackTrace );
        memLog.Lines.Add( '==' );
        memLog.Lines.Add( '' );
      end;
  end;
end;

Стек есть, а для остальных нету.

Не вижу никакой принципиальной разницы между ними...

Добавлено 27.04.10, 07:56
В функции GetExceptionStackInfoJCL стек еще есть, а в GetStackInfoStringJCL уже нету... Info=nil

Добавлено 27.04.10, 08:03
Тааааак....
Нужный стектрейс лежит у вложенного исключения...

Так и должно быть? Почему нет стектрейса у внешнего? Разве стектрей не общий для всей цепочки исключений?

Добавлено 27.04.10, 08:11
Вобщем понятно. Стектрейс надо брать всегда у BaseException... Почему так???

Простым умственным упражнением несложно догадаться, что для наследников EHeapException (коим и является EOutOfMemory) стек вызовов не создаётся никогда. Эту догадку потом можно подтвердить по исходному коду.

Почему? Представьте, что было бы, если бы это было не так. У вас возникает Out of memory и... вы начинаете строить стек вызовов, что приводит к... выделению памяти! Упс.

Добавлено 27.04.10, 08:14

Цитата Felan @ 27.04.10, 07:37

Вобщем понятно. Стектрейс надо брать всегда у BaseException... Почему так???

Неверный вывод из данных фактов. Просто возьмите другой класс.

Цитата CodeMonkey @ 27.04.10, 08:14

Представьте, что было бы, если бы это было не так. У вас возникает Out of memory и... вы начинаете строить стек вызовов, что приводит к... выделению памяти! Упс.

Кэп?!

В общем понятно.

Хотя, StackTrace все равно лучше брать у BaseException. Тогда в него попадают все функции, а если брать у внешнего, то только до той, в которой прозошло само внешнее исключение...

+

Цитата Felan @ 27.04.10, 08:32

Хотя, StackTrace все равно лучше брать у BaseException

Чего, как и сколько граммов - это уже на ваше усмотрение

Опять забыл "вопрос решен" поставить.

делал всё по этой статье http://rsdn.ru/article/Delphi/DelphiJCL.xml
также пробовал по другим источникам-примерам , по примерам из jcl
однако jcl-функции не хотят возвращать стек переходов, в частности функция JclGetExceptStackList, JclLastExceptStackList,JclLastExceptStackListToStrings возвращают nil, пусто
я проинициализировал механизм, включил в свойствах проекта все добавление JCL-debug data, однако ничего не изменилось
взял из примера experts\debug\dialog модуль ExceptDlgMail, который, по словам пользующихся, сам всё инициализирует, его надо только вызвать из приложения, однако в нём также
StackList := JclGetExceptStackList(FThreadID);
в TExceptionDialogMail.CreateReport;
возвращает nil
в чем может быть проблема?

В 13-й строке.

Демо-проект выкладывайте.

P.S. Кстати, материал этого топика обобщён в этой статье.

статья помогла, но тут вроде без JCLDebug это сделано, я могу отключить добавление JCL-debug информации в код?
достаточно оставить Map-detailed в свойствах проекта для получения стека вызовов(со строками вызова)?

JclHookExcept - это установка ловушки исключений. Возбуждается исключение - вызывается ваш код.
JclDebug - это чтение отладочной информации. Хотите получать Form1.Button1Click вместо $00456732 - юзаем модуль.

Понятно, что отладочная информация из воздуха не берётся. Поэтому к JclDebug нужно приложить map-файл, TDS, или заюзать эксперт в IDE.

Вникать.