@Stefan Glienke @dummzeuch
I made some debugging and conclude to three place where a hook could be used :
- ShowException : this is the top-level function that call DoShowException->ReportExceptionNotification.
- DoShowException : this is called by ShowException and returns False(break) and True(continue). When returning continue, a call to Run is necessary in order to continue running the application.
- ReportExceptionNotification: this is the best place (no need to call run) but unfortunately it inits internally a list that is used later. without calling the original method an AV would be thrown.
type
TShowException = procedure(Obj: TObject);
TDoShowException = function(Obj: TObject): Integer;
TGetExceptionMessage = procedure(Obj: TObject; var Msg: string);
TReportExceptionNotification = function(Msg: Pointer; Unkown: ShortInt; Unkown2: Pointer): ShortInt;
var
TrampolineShowException: TShowException;
TrampolineDoShowException: TDoShowException;
TrampolineReportExceptionNotification: TReportExceptionNotification;
GetExceptionMessage: TGetExceptionMessage;
Hooked: Boolean = false;
procedure ShowExceptionHooked(Obj: TObject);
var
Msg: string;
begin
{
this is the toplevel function.
calls DoShowException().
}
GetExceptionMessage(Obj, Msg);
ShowMessage(Msg);
// TrampolineShowException(Obj);
end;
function DoShowExceptionHooked(Obj: TObject): Integer;
var
Msg: string;
MsgResult: Cardinal;
begin
{ DoShowException calls ReportExceptionNotificationHooked }
GetExceptionMessage(Obj, Msg);
MsgResult := MessageBox(0, 'Yes=continue No=Break Cancel=OriginalDialog', PChar(Msg), MB_YESNOCANCEL);
case MsgResult of
IDYES:
begin
Result := 1; // continue.
// need to call Run();
end;
IDNO:
begin
Result := 0; // break.
end;
IDCANCEL:
begin
Result := TrampolineDoShowException(Obj); // original dialog.
end;
end;
end;
function ReportExceptionNotificationHooked(Msg: Pointer; Unkown: ShortInt; Unkown2: TObject): ShortInt;
var
MsgResult: Cardinal;
begin
{
this is the best place where to make a patch ... however internally, it inits a list
if you don't call original function, an AV (list) will be thrown.
}
// type of Msg = string.
MsgResult := MessageBox(0, 'Yes=continue No=Break Cancel=OriginalDialog', '', MB_YESNOCANCEL);
case MsgResult of
IDYES:
begin
Result := 0; // continue.
// no need to call Run().
end;
IDNO:
begin
Result := 1; // break.
end;
IDCANCEL:
begin
Result := TrampolineReportExceptionNotification(Msg, Unkown, Unkown2); // original dialog.
end;
end;
end;
procedure InstallHook();
var
ShowExceptionPtr: Pointer;
DoShowExceptionPtr: Pointer;
ReportExceptionNotificationPtr: Pointer;
begin
if Hooked then
exit;
ShowExceptionPtr := GetProcAddress(GetModuleHandle('dbkdebugide260.bpl'), '@Debug@TDebugger@ShowException$qqrv');
DoShowExceptionPtr := GetProcAddress(GetModuleHandle('win32debugide260.bpl'), '@Win32debug@TNativeDebugger@DoShowException$qqrv');
@GetExceptionMessage := GetProcAddress(GetModuleHandle('dbkdebugide260.bpl'), '@Debug@TDebugger@GetExceptionMessage$qqrv');
ReportExceptionNotificationPtr := GetProcAddress(GetModuleHandle('dbkdebugide260.bpl'),
'@Exceptionnotificationdialog@ReportExceptionNotification$qqrx20System@UnicodeString83System@%Set$56Exceptionnotificationdialog@TExceptionNotificationOptiont1$i0$t1$i2$%r83System@%Set$56Exceptionnotificationdialog@TExceptionNotificaTY6J18n0Wfo24G1hyGAqTA');
assert(ReportExceptionNotificationPtr <> nil);
if Assigned(DoShowExceptionPtr) then
begin
@TrampolineDoShowException := InterceptCreate(DoShowExceptionPtr, @DoShowExceptionHooked);
Hooked := true;
ShowMessage('hook is installed');
end;
end;
procedure RemoveHook();
begin
if Hooked then
InterceptRemove(@TrampolineDoShowException);
end;