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

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

自己レスです。
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;

←解決時は質問者本人がここをチェックしてください。

戻る