unit AssertErrorProc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

// BeginExample: AssertErrorProc
// Routine: System.AssertErrorProc
// Routine: System.Pred

// BeginCode
{
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 hitting "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, so no variables, no compiler generated variables.
Procedure calls are OK.
Note:	This example was originally provided by Brian Long.
}
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');
// EndCode
// EndExample: AssertErrorProc
end.
