Allowing certain fatal exceptions to be handled by the OS instead of the VCL/RTL

Abstract: One of the requirements for Vista certification is that certain FATAL exceptions need to be passed on to the OS, so the automated error reporting mechanism of the OS can be used. In the standard VCL and Delphi RTL most exceptions are caught and handled by the RTL and VCL. The following unit can be used to customize which exceptions will be surfaced to the OS.

The following unit when added to your application will allow you to filter and pass specific exceptions on to the OS.

unit PropagateExceptions;

interface

implementation
uses Windows, Sysutils, Classes, Forms;
type
  TAppExceptionHooker = class
       procedure ExceptionEventHook(Sender: TObject; E: Exception);
  end;


var
OldExceptionObject : function (P: PExceptionRecord):Exception = nil ;
OldExceptProc      : procedure (Obj: Exception; Addr: Pointer) = nil;
AppException       : TAppExceptionHooker = nil;


procedure ReplacementExceptProc(Obj: Exception; Addr: Pointer);
begin
   if not NoErrMsg then
     if @OldExceptProc <> nil then OldExceptProc(Obj, Addr);
end;

function GetExceptionObj(P: PExceptionRecord): Exception;
begin
        Result := nil;
         if @OldExceptionObject <> nil then
         begin
            //Test for fatal exceptions here...
           //Add filtering code here...
            if P.ExceptionCode = STATUS_ACCESS_VIOLATION  then
            begin
              NoErrMsg  := true;
              JITEnable := 1;
            end
            else
            begin
              //just do default processing
              NoErrMsg  := false;
              JITEnable := 0;
            end;
            Result := OldExceptionObject (P);
         end;
end;

procedure InitExpectionPropagation;
begin
   @OldExceptionObject := ExceptObjProc;
   ExceptObjProc := @GetExceptionObj;
   if  AppException = nil then
   begin
      AppException := TAppExceptionHooker.Create;
      Application.OnException := AppException.ExceptionEventHook;
   end;
  @OldExceptProc := ExceptProc;
  ExceptProc := @ReplacementExceptProc;
end;

{ TAppExceptionHooker }

procedure TAppExceptionHooker.ExceptionEventHook(Sender: TObject; E: Exception);
begin
 if not NoErrMsg then
   Application.ShowException(E);
end;

initialization
InitExpectionPropagation;
finalization
end.

Author: Roy Nelson

Allowing certain fatal exceptions to be handled by the OS instead of the VCL/RTL

Translations