Usually the default Exception handler shows only the Message of
a exception.
But a EOleException provides more information.
property ErrorCode: HRESULT;
property HelpFile: string;
property Source: string;
So we have to write our own exception handler.
I suggest to implement the Exception handler on the main form.
TMainForm = class(TForm)
private
procedure InstallExceptionHandler;
procedure ExceptionHandler(Sender: TObject; E: Exception);
public
end;
implementation
Uses ....,comobj;
// call the following procedure from OnCreate on the form
procedure TMainFrm.InstallExceptionHandler;
begin
Application.OnException := ExceptionHandler;
end;
function HResultToStr(hr : HRESULT):string;
type
TFLookup = record
fc : Integer;
fs : string;
end;
const
farray : array[0..21] of TFLookup = (
( fc:0; fs:'Null'),
( fc:1; fs:'RPC'),
( fc:2; fs:'Dispatch'),
( fc:3; fs:'Storage'),
( fc:4; fs:'ITF'),
( fc:7; fs:'Win32'),
( fc:8; fs:'Windows'),
( fc:9; fs:'SSPI'),
( fc:10; fs:'Control'),
( fc:11; fs:'Cert'),
( fc:12; fs:'Internet'),
( fc:13; fs:'Media Server'),
( fc:14; fs:'MSMQ'),
( fc:15; fs:'Setup API'),
( fc:16; fs:'SCard'),
( fc:17; fs:'MTS (?)'),
( fc:109; fs:'Visual C++'),
( fc:119; fs:'VDI (?)'),
( fc:769; fs:'IC'),
( fc:2047;fs:'Backup'),
( fc:2048;fs:'EDB'),
( fc:2304;fs:'MDSI')
);
var
i : Integer;
begin
for i := low(farray) to high(farray) do
begin
if farray[i].fc = HResultFacility(hr) then
begin
Result := Format('Facility: %s Code: %d', [farray[i].fs, HResultFacility(hr)]);
Exit;
end;
end;
Result := Format('Facility: %4.4X Code: %d', [HResultFacility(hr), HResultFacility(hr)]);
end;
function FullOleExceptionMessage(E : EOleException):string;
begin
// add more information to the exception message
Result := E.Message+#13#10+
'Source: '+E.Source+#13#10+
Format('Error Code: %d [%.8X]', [E.ErrorCode, E.ErrorCode])+#13#10+
// the E.ErrorCode is a HRESULT
// we show this as error type, facility and code
// severity is allways 1
HResultToStr(E.ErrorCode)
;
end;
procedure ShowOleException(E : EOleException);
var
buttons : TMsgDlgButtons;
begin
if IsConsole then
begin
Writeln(FullOleExceptionMessage(E));
if E.Helpfile <> '' then
Writeln('see help file ', E.helpfile, 'context: ', E.HelpContext);
end
else
begin
buttons := [mbOK]; // OK button for the dialog box
if E.HelpFile <> '' then
begin
// add a Help button only if a help file was given
Include(buttons, mbHelp);
end;
// display the exception message
MessageDlgPosHelp(FullOleExceptionMessage(E), mtError, buttons, E.HelpContext, -1, -1, E.HelpFile);
end;
end;
// this is our new exception handler
procedure TMainForm.ExceptionHandler(Sender: TObject; E: Exception);
begin
if E is EOleException then
ShowOleException(EOleException(E))
else
// show other exceptions
Application.ShowException(E);
end;
Sign Up
