AssertErrorProc (Delphi)

From RAD Studio Code Examples
Jump to: navigation, search

Description

The following code is a self-contained unit that you can add to a project that logs failed assertions to the event log rather than raising an exception. If /Debug is passed to the application as a command-line parameter, all failed Assert calls cause a call to OutputDebugString, which sends a messages to the Event Log window if run from Delphi, or does nothing if run outside the IDE (OutputDebugString is a no-op if not run from within a debugger). A nice side benefit is that all the line numbers and unit names can be stripped from the EXE by turning off assertions and rebuilding the project. Build the executable in the IDE by pressing Run. Then go to the debug directory for the project and execute the command line "AssertErrorProc_proj /Debug". Note: AssertErrorHandler should do as little as possible. This routine does no cleanup and no variables. Procedure calls are OK. Note: This example was originally provided by Brian Long.

Code

type
  TForm1 = class(TForm)
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TStorage = class(TObject)
    FData: string;
    property Data: string read FData write FData;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  var
  Form1: TForm1;

procedure AssertErrorHandler(const Message, Filename: string;  LineNumber: Integer; ErrorAddr: Pointer);

implementation

{$R *.dfm}

{$ASSERTIONS ON}

type
  EMyAssert = class(Exception);
  

procedure DoMessage(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))]);
  OutputDebugString(PChar(S));
end;

procedure AssertErrorHandler(const Message, Filename: string;  LineNumber: Integer; ErrorAddr: Pointer);
{ No local variables. Not compiler generated temporary variables. }
{ Using the call stack here will cause Access Violation errors. }
begin
  DoMessage(Message, Filename, LineNumber, ErrorAddr);
  raise EMyAssert.Create('Boom!');
end;

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

procedure ModifyStorage(AStorage: TStorage; const s: string);
begin
  Assert(AStorage <> nil, 'Value');
  AStorage.Data := s;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ModifyStorage(nil, 'Oops');
end;

initialization
  if FindCmdLineSwitch('Debug', ['/', '-'], True) then
  begin
    MessageDlg('Command line switch found!', mtInformation, [mbOK], 0);
//    OldProc := System.AssertErrorProc;
    System.AssertErrorProc := @AssertErrorHandler
  end
  else
    System.AssertErrorProc := @AssertErrorNoHandler;

  ModifyStorage(nil, 'Ooops');

Uses