Ole-Exceptions verarbeiten & anzeigen

[shmia]

Eine OleException (Klasse EOleException) hat mehr Informationen zu bieten
als nur einen Fehlertext (property Message).

Dies sind im Einzelnen:

• ErrorCode
• Source
• HelpFile

Im ErrorCode sind 3 Informationen codiert:
Serverity (ist immer 1)
Facility
Code

Die folgende Unit dient dazu, diese zusätzlichen Informationen aufzubereiten
und dem Bediener zu präsentieren. Sollte das COM-Objekt, das die OLE Exception
ausgelöst hat, eine Hilfedatei mitführen, bietet die Delphi-Anwendung auch gleich
einen Hilfe-Button an.

Delphi-Quellcode:

unit UOleException;

interface

uses comobj;

function FullOleExceptionMessage(E : EOleSysError):string;
procedure ShowOleException(E : EOleSysError);
function HResultToStr(hr : HRESULT):string;


implementation

uses SysUtils, windows, dialogs;


function FullOleExceptionMessage(E : EOleSysError):string;
begin
   if E is EOleException then
   begin

   // add more information to the exception message
   Result := E.Message+#13#10#13#10+
      'Source: '+EOleException(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 always 1

      HResultToStr(E.ErrorCode)
      ;
   end
   else
   begin
   // add more information to the exception message
   Result := E.Message+#13#10#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;
end;


procedure ShowOleException(E : EOleSysError);
var
   buttons : TMsgDlgButtons;
   helpfile : string;
begin
   if E is EOleException then
      helpfile := EOleException(E).HelpFile;

   if IsConsole then
   begin
      Writeln(FullOleExceptionMessage(E));
      if helpfile <> '' then
         Writeln('see help file ', helpfile, 'context: ', EOleException(E).HelpContext);
   end
   else
   begin
      buttons := [mbOK];  // OK button for the dialog box
      if 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, helpfile);
   end;
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;

end.

Nachdem man obige Unit ins Projekt eingebunden hat und die Funktionen/Proceduren
mit Uses eingebunden hat, gibt es folgende Anwendungsmöglichkeiten:

Delphi-Quellcode:

// OleException abfragen, mit zusätzl. Infos anreichen und erneut auslösen
try
   ... // mach was, dass eine EOleException auslösen kann
except
  on E:EOleException do
  begin
    E.Message := FullOleExceptionMessage(E);  
    raise;  // erneut auslösen
  end;
end;

Delphi-Quellcode:

// Exceptions auf Applicationsebene abfangen und falls es sich um eine OleException
// handelt mit ShowOleException anzeigen
// dazu lässt man einfach das Event Application.OnException auf unseren selbstgebauten
// Handler zeigen
procedure TMainForm.HandleOnException(Sender: TObject; E: Exception);
begin
  if (E is EOleException) then
    ShowOleException(EOleException(E))  // Spezialbehandlung für OleExceptions
  else
    Application.ShowException(E);       // alle anderen Exceptions
end;

[edit=Matze]Code formatiert. Mfg, Matze[/edit]
[edit=fkerber]Neue Version von shmia eingefügt - nun wird auch EOleSysError akzeptiert. Mfg, fkerber[/edit]