Globale Exceptions abfangen?

[Sir Rufo]

Da ich die Idee gar nicht mal so abwegig finde, habe ich das mal rudimentär so umgesetzt, wie ich mir das vorstelle

- Die AppExceptions werden nur umgebogen, wenn die DLL auch vorhanden ist
- Das Umbiegen erfolgt automatisch durch das Einbinden einer Unit
- In dieser Unit wird die Exception in die relevanten Einzelteile zerlegt und der DLL zugeführt

Hier die Unit zum Einbinden:

Delphi-Quellcode:

unit uAppExceptionHandlerClass;

// Dieses ist die Verbindung zwischen dem Delphi-Programm und der DLL

interface

uses
  Windows, SysUtils;

type
  TAppException = procedure( ParentForm, Sender : Pointer; lExeName, lMessage,
    lStackTrace : PChar; HelpContext : integer );

type
  TAppExceptionHandlerClass = class
  private
    FDLLHandle : cardinal;
    procedure SetDLLHandle( const Value : cardinal );
    function GetFarProc( const FarProcName : string; var FarProc : TFarProc )
      : boolean;

  public
    property DLLHandle : cardinal read FDLLHandle write SetDLLHandle;
    procedure AppExceptionHandler( Sender : TObject; E : Exception );
    function LoadDLL : boolean;
    function UnloadDLL : boolean;
  end;

var
  FAppExceptionHandler : TAppExceptionHandlerClass;

implementation

uses
  Dialogs, Forms;

const
  AppExceptionHandlerDLLName = 'insaexhd.dll';

procedure BindDLL;
  var
    proc : TFarProc;
  begin
    with FAppExceptionHandler do
      if LoadDLL then
        if GetFarProc( 'AppException', proc ) then
          Application.OnException := AppExceptionHandler;
  end;

procedure UnbindDLL;
  begin
    with FAppExceptionHandler do
      if not UnloadDLL then
        ShowMessage( 'DLL konnte nicht entladen werden!' );
  end;

{ TAppExceptionHandlerClass }

procedure TAppExceptionHandlerClass.AppExceptionHandler
  ( Sender : TObject; E : Exception );
  var
    proc : TFarProc;
  begin
    if GetFarProc( 'AppException', proc ) then
      TAppException( proc )( Application.MainForm, Sender, PChar
          ( Application.ExeName ), PChar( E.Message ), PChar( E.StackTrace ),
        E.HelpContext );
  end;

function TAppExceptionHandlerClass.GetFarProc( const FarProcName : string;
  var FarProc : TFarProc ) : boolean;
  begin
    if LoadDLL then
      FarProc := GetProcAddress( DLLHandle, PChar( FarProcName ) )
    else
      FarProc := nil;
    RESULT := Assigned( FarProc );
  end;

function TAppExceptionHandlerClass.LoadDLL : boolean;
  begin
    if ( DLLHandle = 0 ) then
      DLLHandle := LoadLibrary( PChar( AppExceptionHandlerDLLName ) );
    RESULT := ( DLLHandle <> 0 );
  end;

procedure TAppExceptionHandlerClass.SetDLLHandle( const Value : cardinal );
  begin
    FDLLHandle := Value;
  end;

function TAppExceptionHandlerClass.UnloadDLL : boolean;
  begin
    if ( DLLHandle <> 0 ) then
      if FreeLibrary( DLLHandle ) then
        DLLHandle := 0;
    RESULT := ( DLLHandle = 0 );
  end;

initialization

FAppExceptionHandler := TAppExceptionHandlerClass.Create;
BindDLL;

finalization

UnbindDLL;
FreeAndNil( FAppExceptionHandler );

end.

Die DLL im Anhang ist mit D2010 compiliert, somit sind die Parameter vom Typ PWideChar!
Dieses sollte/müsste in dem Projekt noch berücksichtigt werden, damit eine DLL auch
universell einsetzbar ist.

cu

Oliver