例外の発生したユニット名、行番号を取得するには？

moru 2008-03-14 03:12:41 No: 30157

いつもお世話になっております。
早速ですが、客先で例外やアドレス違反が発生した場合に、メッセージやログにユニット名(ファイル名)、行番号を取得表示をさせたいと思っています。
調べたところ、AssertErrorProc変数とtry〜exceptを使って、以下のようにしようと思います。
しかし、ネストされた関数内でのアドレス違反など予期しないエラーを捉えることができない場合もあります。
皆さんは似たような事で良い方法をご存じでないでしょうか？
それとも、このやり方自体誤ってますか？
別の方法や、つっこみをよろしくお願いします。

private
bAssert: Boolean;
end;

procedure AssertErrorHandler(const Message, Filename: string;  LineNumber: Integer; ErrorAddr: Pointer);
var
  S: String;
begin
  S := Format('%s (%s, line %d, address $%x)',
    [Message, Filename, LineNumber, Pred(Integer(ErrorAddr))]);
  showmessage(S);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
bAssert := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // ボタン１クリックで、ユニット名、行番号表示モードに入る
  bAssert := True;
  AssertErrorProc := @AssertErrorHandler;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  List : TStringList;
begin
  try
    List.Add(''); // アドレス違反発生

  except
    // エラーが発生したユニット名、行番号を表示
    Assert(bAssert);

    if (bAssert = True) then
      // 通常は、そのまま例外発生
      raise;
  end;
end;

moru 2008-03-18 21:22:07 No: 30158

自己レスです。
IDE以外から実行したときに、Assertが実行されないようにした点、任意のAssertのみをエラーログを残す処理などをするようにした点を修正しました。

private
bClientAssert: Boolean;
AssertErrorProcOrg: Pointer;
end;

const
CLIENT_ASSERT = 'ClientAssert:';

procedure AssertErrorHandler(const Message, Filename: string;  LineNumber: Integer; ErrorAddr: Pointer);
var
  S: String;
begin
  // Messageに特定の文字列を見つけた場合だけ表示する
  if (AnsiContainsText(Message, CLIENT_ASSERT) = False) then
    Exit;

S := Format('%s (%s, line %d, address $%x)',
[Message, Filename, LineNumber, Pred(Integer(ErrorAddr))]);

// ログファイルへ書き込みなど

end;

procedure AssertErrorNoHandler(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
end;

//////////////////////
// IDEからの実行か調べる
function IsDebuggerPresent:Boolean;
type
  TFuncType = function ():Bool;stdcall;
var
  Handle:THandle;
  IsFromDelphiIDE:TFuncType;
begin
  Handle := LoadLibrary('kernel32.dll');
  @IsFromDelphiIDE := GetProcAddress(Handle,'IsDebuggerPresent');

result := IsFromDelphiIDE;
FreeLibrary(Handle);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // IDE以外からの実行時は、Assertを無効にしておく
  if (IsDebuggerPresent = False) then
    AssertErrorProc := @AssertErrorNoHandler;

AssertErrorProcOrg := @AssertErrorProc;

bClientAssert := False;
end;

////////////////////////
// Button1Click
// Assert実行時の動作切替
procedure TForm1.Button1Click(Sender: TObject);
begin
  bClientAssert := not(bClientAssert);

  if (bClientAssert = True) then
    AssertErrorProc := @AssertErrorHandler
  else
    AssertErrorProc := AssertErrorProcOrg;
end;

//////////////////////
// Button2Click
// エラーを発生させる
procedure TForm1.Button2Click(Sender: TObject);
var
  List : TStringList;
begin
  try
    List.Add(''); // アドレス違反発生

  except
    on E: Exception do begin
      Assert(not(bClientAssert), CLIENT_ASSERT + E.Message);
      if (bClientAssert = False) then
        raise;
    end;
  end;
end;