AssertErrorProc (Delphi)
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
- System.AssertErrorProc ( fr | de | ja )
- System.Pred ( fr | de | ja )