Displaying Custom Exceptions Dialogs and write Exceptions to the NT Event Log (component set)

Problem/Question/Abstract:

Often, the simple message box (and its ping) are just annoying, and they don't tell us where exactly our problem has started. This component will allow you to override Delphis standard exception handler and create your custom exception dialogs as you want them to look.

Answer:

Introduction

Delphi has become (one of) the best programming language/tool on the market. And by now, everyone should be aware of the fact, that you can control and manage every fact of your Delphi application. Just how can we? Well, this time, we are going to look into Delphi Exception handling and start to go new ways.

If you are interessted in a more detailed introduction to component writing and especially this component, come and read my German course on "Component Developement" in the German Delphi-PRAXiS community. It has just started, and this component will be part of the next few lectures.

The way Delphi goes

Usually, when you have an untrapped exception, you get a simple message box, that displays the error message - that's it.




This error message does not give any useful information to most users and certainly it doesn't help programmers most the time either. What we need is just more.

Open up, Delphi!

Delphis Application object has an event property named Application.OnException. This is our entry point to start catching all unhandled exceptions. The event handler is defined as

TExceptionEvent = procedure(Sender: TObject; E: Exception) of object;

At the end of this article, you will be able to display dialog boxes for all exceptions like this one - or any other way you want.




Going further

Another step we want to take is the Windows NT Event Log. Our component can write error messages to the log. At design-time you'll simply have to add the component TEventLog, bundled together with this component download, to the project and assign it to the TExceptionManager component. (Unit: EventLog)

Further, we enhance this component by analyzing the mapping file, created during compilation by Delphi. A seperate class (not as component) will take care of analyzing the mapping file and, at run-time, anaylze the last error occured and retrieve information about unit name and method as well as the line number, where the error has occured. The mapping file has to have the same name as the EXE file of the application, with the extension .map. It has to be in the same directory. (Unit: MapFile)

Note: You have to turn on the creation of the mapping file in Delphi.
  Menu: Projet | Options
  Page: Linker
  Map File: Detailed

Note: Further information on mapping files you'll find at the DKB article Advanced Debug manager (Exception handler) by Olivier Rogier.

The frame work

During application start up we will create the actual exception handler (TExceptionHandler) in the background. (Unit: ExceptionHandler) Since only one Exception Manager (TExceptionManager) can work at any time, our exception handler will take care of the right assignments. Since the Exception Handler will not be created at design-time automatically, we have to take care of this separately.

When an Exception Manager wants to take control of exceptions occuring, we will set its Active property to true. In the background our Exception Manager will "tell" the Exception Handler that it takes control. When another Exception Manager takes control, the Exception Handler will acknowledge the fact and pass on the control.

The Exception Handler

Two more methods I want to explain shortly.

procedure ExceptionHandler(Sender: TObject; ExceptObject: Exception);

The method ExceptionHandler will be assigned to the Application.OnException Event. All exceptions will be passed to this event handler.

{... }
    // analyze exception
FMapFile.LoadExceptionData;
// handle exception
Handled := False;
if Assigned(FCurrentManager.OnException) then
  // event handler is assigned
  FCurrentManager.OnException(
    Sender, ExceptObject, ExceptAddr, FMapFile.ExceptionAnalyzed,
    FMapFile.ExceptAddress, FMapFile.ExceptUnitName,
    FMapFile.ExceptMethodName, FMapFile.ExceptLineNumber, Handled
    );
if Handled then
  // the event handler has finished processing message, stop
  Exit;
{... }

First we will try to analyze the mapping file. Next we check for a custom event handler with the current Exception Manager and pass on the event. If the custom handler has finished all work we'll stop, otherwise we continue with the default event handling.

procedure DeactivateExceptionHandler; override;

The method DeactivateExceptionHandler will check, whether our Exception Handler is active. In this case it will assign the saved default excpetion handler back to the Application.OnException event (usually nil) and cancel the current manager.

{... }
if ThisHandlerIsActive then
begin
  // disable exception Manager
  Application.OnException := FDelphiExceptionHandler;
  FDelphiExceptionHandler := nil;
  FCurrentManager := nil;
end;
{... }

The Exception Manager

The Exception Manager provides different properties that allow the programmer to define the behavior during an exception.

Active - Set to True to activate the Exception Manager. Only one can be active at any time. The others will be set to inactive, automatically.
Eventlog - Assign an Eventlog component to this property if you want the Exception Handler to log exceptions into the Windows NT Eventlog. It will skip automatically on other Windows systems.
MessageDetails - Turn on/off the information you want to show to the user/save to the eventlog.
Options - Turn on/off the actions you want the Event Handler to take during an exception.

THE CODE SNIPPETS

You can either start with these or simply download the component and the sample application.
Download here

The Eventlog

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Unit Name : EventLog
* Autor     : Daniel Wischnewski
* Copyright : Copyright © 2002 by gate(n)etwork. All Right Reserved.
* Urheber   : Daniel Wischnewski
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

unit EventLog;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TEventLog = class(TComponent)
  private
    FConnected: Boolean;
    FTypesSupported: Integer;
    FCategoryCount: Integer;
    FCategoryMessageFile: string;
    FEventSource: string;
    FEventMessageFile: string;
    FEventLog: THandle;
    FMachine: string;
    function GetOSCanLogEvents: Boolean;
    procedure SetCategoryCount(const Value: Integer);
    procedure SetCategoryMessageFile(const Value: string);
    procedure SetEventMessageFile(const Value: string);
    procedure SetEventSource(const Value: string);
    procedure SetTypesSupported(const Value: Integer);
    procedure SetConnected(const Value: Boolean);
    procedure DoConnect(const Value: Boolean);
    procedure SetMachine(const Value: string);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure RegisterEventSource;
    procedure LogEvent(
      Message: TStrings; Data: string = ''; aEventID: Word = 0;
      aCategoryID: Word = 1; aEventType: Word = EVENTLOG_ERROR_TYPE
      ); overload;
  published
    { Published declarations }
    property OSCanLogEvents: Boolean read GetOSCanLogEvents;
    property EventSource: string read FEventSource write SetEventSource;
    property Machine: string read FMachine write SetMachine;
    property CategoryMessageFile: string read FCategoryMessageFile write
      SetCategoryMessageFile;
    property EventMessageFile: string read FEventMessageFile write
      SetEventMessageFile;
    property CategoryCount: Integer read FCategoryCount write SetCategoryCount;
    property TypesSupported: Integer read FTypesSupported write SetTypesSupported;
    property Connected: Boolean read FConnected write SetConnected;
  end;

procedure Register;

implementation

uses
  Registry;

{$R *.DCR}

procedure Register;
begin
  RegisterComponents('gate(n)etwork', [TEventLog]);
end;

function IsNT: Boolean;
var
  OSVersion: TOSVersionInfo;
  OSId: Integer;
begin
  with OSVersion do
  begin
    dwOSVersionInfoSize := sizeOf(TOSVersionInfo);
    if not getVersionEx(OSVersion) then
      OSId := -1
    else
      OSId := dwPlatformId;
  end;
  Result := (OSId = VER_PLATFORM_WIN32_NT);
end;

{ TEventLog }

constructor TEventLog.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FConnected := False;
  FTypesSupported := 1;
  FCategoryCount := 1;
  FCategoryMessageFile := '';
  FEventSource := Application.Name;
  FEventMessageFile := '';
  FEventLog := 0;
  FMachine := '';
end;

destructor TEventLog.Destroy;
begin
  DoConnect(False);
  inherited Destroy;
end;

procedure TEventLog.DoConnect(const Value: Boolean);
begin
  if csDesigning in ComponentState then
    FConnected := Value and (FEventSource <> '')
  else if FEventSource <> '' then
    if (FConnected <> Value) and OSCanLogEvents then
    begin
      if FConnected then
      begin
        DeregisterEventSource(FEventLog);
        FEventLog := 0;
      end
      else
      begin
        if FMachine <> '' then
          FEventLog := Windows.RegisterEventSource(
            PChar(FMachine), PChar(FEventSource)
            )
        else
          FEventLog := Windows.RegisterEventSource(nil, PChar(FEventSource));
      end;
      FConnected := FEventLog <> 0;
    end;
end;

function TEventLog.GetOSCanLogEvents: Boolean;
begin
  Result := IsNT;
end;

procedure TEventLog.LogEvent(
  Message: TStrings; Data: string; aEventID, aCategoryID, aEventType: Word
  );
var
  I: Integer;
  MessageStr: array of PChar;
  MessageCount: Word;
begin
  if Connected then
  begin
    MessageCount := Message.Count;
    SetLength(MessageStr, MessageCount);
    try
      for I := 0 to MessageCount - 1 do
        MessageStr[I] := StrNew(PChar(Message.Strings[I]));
      try
        if Data <> '' then
          Windows.ReportEvent(
            FEventLog, aEventType, aCategoryID, aEventID, nil, MessageCount,
            Length(Data), MessageStr, @Data[1]
            )
        else
          Windows.ReportEvent(
            FEventLog, aEventType, aCategoryID, aEventID, nil, MessageCount, 0,
            MessageStr, nil
            )
      finally
        for I := 0 to MessageCount - 1 do
          StrDispose(MessageStr[I]);
      end;
    finally
      SetLength(MessageStr, 0);
    end;
  end;
end;

procedure TEventLog.RegisterEventSource;
begin
  with TRegistry.Create(
    STANDARD_RIGHTS_ALL or KEY_SET_VALUE or KEY_CREATE_SUB_KEY
    ) do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey(
      '\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + FEventSource,
      True
      ) then
    try
      WriteString('CategoryMessageFile', FCategoryMessageFile);
      WriteString('EventMessageFile', FEventMessageFile);
      WriteInteger('CategoryCount', FCategoryCount);
      WriteInteger('TypesSupported', FTypesSupported);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

procedure TEventLog.SetCategoryCount(const Value: Integer);
begin
  FCategoryCount := Value;
end;

procedure TEventLog.SetCategoryMessageFile(const Value: string);
begin
  FCategoryMessageFile := Value;
end;

procedure TEventLog.SetConnected(const Value: Boolean);
begin
  if FEventSource = '' then
    DoConnect(False)
  else
    DoConnect(Value);
end;

procedure TEventLog.SetEventMessageFile(const Value: string);
begin
  FEventMessageFile := Value;
end;

procedure TEventLog.SetEventSource(const Value: string);
begin
  FEventSource := Value;
  if FEventSource = '' then
    DoConnect(False)
  else if Connected then
  begin
    DoConnect(False);
    DoConnect(True);
  end;
end;

procedure TEventLog.SetMachine(const Value: string);
begin
  if FMachine <> Value then
  begin
    FMachine := Value;
    if (FEventSource <> '') and Connected then
    begin
      DoConnect(False);
      DoConnect(True);
    end;
  end;
end;

procedure TEventLog.SetTypesSupported(const Value: Integer);
begin
  FTypesSupported := Value;
end;

end.

The Exception Handler

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Unit Name : ExceptionHandler
* Autor     : Daniel Wischnewski
* Copyright : Copyright &copy; 2002 by gate(n)etwork. All Right Reserved.
* Urheber   : Daniel Wischnewski
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

unit ExceptionHandler;

interface

uses
  Classes, SysUtils, Forms, Windows,
  ExceptionManager, MapFile;

type
  TBaseExceptionHandler = class
  private
  protected
    function GetActive(Manager: TExceptionManager): Boolean; virtual; abstract;
    procedure SetActive(
      Manager: TExceptionManager; Value: Boolean
      ); virtual; abstract;
  public
    procedure RegisterManager(
      const Manager: TExceptionManager
      ); virtual; abstract;
    procedure UnRegisterManager(
      const Manager: TExceptionManager
      ); virtual; abstract;

    procedure DeactivateExceptionHandler; virtual; abstract;

    property Active[Manager: TExceptionManager]: Boolean
    read GetActive write SetActive;
  end;

function GetExceptionHandler: TBaseExceptionHandler;

implementation

var
  gExceptionHandler: TBaseExceptionHandler;
  gDesignModus: Boolean = True;

type
  TExceptionHandler = class(TBaseExceptionHandler)
  private
    FDelphiExceptionHandler: TExceptionEvent;
    FCurrentManager: TExceptionManager;
    FExceptionManagers: TList;
    FMapFile: TMapFile;
    function ThisHandlerIsActive: Boolean;
  protected
    function GetActive(Manager: TExceptionManager): Boolean; override;
    procedure SetActive(Manager: TExceptionManager; Value: Boolean); override;
    procedure ExceptionHandler(Sender: TObject; ExceptObject: Exception);
  public
    constructor Create;
    destructor Destroy; override;
    procedure RegisterManager(const Manager: TExceptionManager); override;
    procedure UnRegisterManager(const Manager: TExceptionManager); override;
    procedure DeactivateExceptionHandler; override;
  end;

function GetExceptionHandler: TBaseExceptionHandler;
begin
  if gExceptionHandler = nil then
    gExceptionHandler := TExceptionHandler.Create;
  Result := gExceptionHandler;
end;

{ TExceptionHandler }

constructor TExceptionHandler.Create;
begin
  inherited Create;
  FDelphiExceptionHandler := nil;
  FExceptionManagers := TList.Create;
  FMapFile := TMapFile.Create;
  FMapFile.MapFileName := ChangeFileExt(Application.ExeName, '.map');
end;

procedure TExceptionHandler.DeactivateExceptionHandler;
begin
  if ThisHandlerIsActive then
  begin
    // disable exception Manager
    Application.OnException := FDelphiExceptionHandler;
    FDelphiExceptionHandler := nil;
    FCurrentManager := nil;
  end;
end;

destructor TExceptionHandler.Destroy;
begin
  DeactivateExceptionHandler;
  FreeAndNil(FMapFile);
  FreeAndNil(FExceptionManagers);
  inherited Destroy;
end;

procedure TExceptionHandler.ExceptionHandler(
  Sender: TObject; ExceptObject: Exception
  );
var
  Handled: Boolean;
  SL: TStringList;
begin
  if FCurrentManager <> nil then
  begin
    // analyze exception
    FMapFile.LoadExceptionData;
    // handle exception
    Handled := False;
    if Assigned(FCurrentManager.OnException) then
      // event handler is assigned
      FCurrentManager.OnException(
        Sender, ExceptObject, ExceptAddr, FMapFile.ExceptionAnalyzed,
        FMapFile.ExceptAddress, FMapFile.ExceptUnitName,
        FMapFile.ExceptMethodName, FMapFile.ExceptLineNumber, Handled
        );
    if Handled then
      // the event handler has finished processing message, stop
      Exit;

    // create message
    SL := TStringList.Create;
    try
      if mdMessage in FCurrentManager.MessageDetails then
      begin
        SL.Add(ExceptObject.Message);
        if FCurrentManager.MessageDetails - [mdMessage] <> [] then
          SL.Add('');
      end;
      if FMapFile.ExceptionAnalyzed then
      begin
        if mdAddress in FCurrentManager.MessageDetails then
        begin
          SL.Add('Exception Address: ' + IntToHex(FMapFile.ExceptAddress, 8));
          if FCurrentManager.MessageDetails - [mdMessage, mdAddress] <> [] then
            SL.Add('');
        end;
        if mdSourceInformation in FCurrentManager.MessageDetails then
        begin
          SL.Add('Information about Source of Exception');
          SL.Add('Unit: ' + FMapFile.ExceptUnitName);
          SL.Add('Method: ' + FMapFile.ExceptMethodName);
          SL.Add('Line: ' + IntToStr(FMapFile.ExceptLineNumber));
        end;
      end;
      if eoShowMessageToUser in FCurrentManager.Options then
        MessageBox(
          0, PChar(SL.Text), PChar('Exception handled: ' + FCurrentManager.Name),
          MB_OK or MB_ICONERROR
          );
      if eoLogToNTEventLog in FCurrentManager.Options then
        if Assigned(FCurrentManager.EventLog) then
          FCurrentManager.EventLog.LogEvent(SL);
    finally
      SL.Free;
    end;
    if eoTerminateOnException in FCurrentManager.Options then
      Application.Terminate;
  end;
end;

function TExceptionHandler.GetActive(Manager: TExceptionManager): Boolean;
begin
  Result := ThisHandlerIsActive and (FCurrentManager = Manager);
end;

procedure TExceptionHandler.RegisterManager(const Manager: TExceptionManager);
begin
  if FExceptionManagers.IndexOf(Manager) < 0 then
    FExceptionManagers.Add(Manager);
end;

procedure TExceptionHandler.SetActive(
  Manager: TExceptionManager; Value: Boolean
  );
begin
  if Value <> Active[Manager] then
    if Value and Assigned(Manager) then
    begin
      // check for design mode
      if not gDesignModus then
      begin
        // enable exception Manager
        if not ThisHandlerIsActive then
          FDelphiExceptionHandler := Application.OnException;
        Application.OnException := ExceptionHandler;
        FCurrentManager := Manager;
      end;
    end
    else
    begin
      DeactivateExceptionHandler;
    end;
end;

function TExceptionHandler.ThisHandlerIsActive: Boolean;
var
  MyEH: TExceptionEvent;
begin
  // get handle to lokal exception Manager
  MyEH := ExceptionHandler;
  // compare to global exception Manager
  Result := (Addr(Application.OnException) = Addr(MyEH));
end;

procedure TExceptionHandler.UnRegisterManager(const Manager: TExceptionManager);
begin
  // remove manager from controlled list
  if FExceptionManagers.IndexOf(Manager) >= 0 then
    FExceptionManagers.Remove(Manager);
  Active[Manager] := False;

  if gDesignModus then
    // during design-time
    if FExceptionManagers.Count = 0 then
    begin
      // destroy the exception Manager if last manager is removed from list
      gExceptionHandler := nil;
      Destroy;
    end;
end;

initialization
  // this part will not be executed at design-time
  gExceptionHandler := TExceptionHandler.Create;
  // therefore we can fetch the design-time state
  gDesignModus := False;
finalization
  // free all stuff :-)
  FreeAndNil(gExceptionHandler);
end.

The Exception Manager

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Unit Name : ExceptionManager
* Autor     : Daniel Wischnewski
* Copyright : Copyright &copy; 2002 by gate(n)etwork. All Right Reserved.
* Urheber   : Daniel Wischnewski
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

unit ExceptionManager;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  EventLog;

type
  // different possibilities for handling exceptions
  TExceptionOptions = (
    eoShowMessageToUser, eoLogToNTEventLog, eoTerminateOnException
    );
  TExceptionOptionSet = set of TExceptionOptions;

  // options for message details to display
  TMessageDetails = (
    mdMessage, mdAddress, mdSourceInformation
    );
  TMessageDetailSet = set of TMessageDetails;

  // definition for custom exception handler
  TCustomExceptionHandler = procedure(
    Sender: TObject; ExceptObject: Exception; ExceptionAddr: Pointer;
    ExceptionAnalyzed: Boolean; Address: DWORD; UnitName, MethodName: string;
    LineNum: DWORD; var Handled: Boolean
    ) of object;

  TExceptionManager = class(TComponent)
  private
    FOptions: TExceptionOptionSet;
    FMessageDetails: TMessageDetailSet;
    FOnException: TCustomExceptionHandler;
    FEventLog: TEventLog;
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetOptions(const Value: TExceptionOptionSet);
    procedure SetMessageDetails(const Value: TMessageDetailSet);
    procedure SetOnException(const Value: TCustomExceptionHandler);
    { Private declarations }
  protected
    { Protected declarations }
    procedure Notification(
      aComponent: TComponent; Operation: TOperation
      ); override;
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure DeactivateAllManagers;
  published
    { Published declarations }
    property Active: Boolean read GetActive write SetActive;
    property Options: TExceptionOptionSet read FOptions write SetOptions;
    property MessageDetails: TMessageDetailSet
      read FMessageDetails write SetMessageDetails;
    property OnException: TCustomExceptionHandler
      read FOnException write SetOnException;
    property EventLog: TEventLog read FEventLog write FEventLog;
  end;

procedure Register;

implementation

uses
  ExceptionHandler;

{$R *.DCR}

procedure Register;
begin
  RegisterComponents('gate(n)etwork', [TExceptionManager]);
end;

{ TExceptionManager }

constructor TExceptionManager.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  GetExceptionHandler.RegisterManager(Self);
  FOptions := [eoShowMessageToUser];
  FMessageDetails := [mdMessage, mdAddress, mdSourceInformation];
  FOnException := nil;
  FEventLog := nil;
end;

procedure TExceptionManager.DeactivateAllManagers;
begin
  GetExceptionHandler.DeactivateExceptionHandler;
end;

destructor TExceptionManager.Destroy;
begin
  GetExceptionHandler.UnRegisterManager(Self);
  inherited Destroy;
end;

function TExceptionManager.GetActive: Boolean;
begin
  Result := GetExceptionHandler.Active[Self];
end;

procedure TExceptionManager.Notification(aComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(aComponent, Operation);
  if (Operation = opRemove) then
  begin
    if aComponent = FEventLog then
      FEventLog := nil;
  end;
end;

procedure TExceptionManager.SetActive(const Value: Boolean);
begin
  GetExceptionHandler.Active[Self] := Value;
end;

procedure TExceptionManager.SetMessageDetails(const Value: TMessageDetailSet);
begin
  FMessageDetails := Value;
end;

procedure TExceptionManager.SetOnException(
  const Value: TCustomExceptionHandler
  );
begin
  FOnException := Value;
end;

procedure TExceptionManager.SetOptions(const Value: TExceptionOptionSet);
begin
  FOptions := Value;
end;

end.

The Mapping File

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Unit Name : MapFile
* Autor     : Daniel Wischnewski
* Copyright : Copyright &copy; 2002 by gate(n)etwork. All Right Reserved.
* Urheber   : Daniel Wischnewski
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

unit MapFile;

interface

uses
  SysUtils, Classes, Windows;

type
  TMapFile = class
  private
    FMapFileName: string;
    FSegmentData, FAdressData, FLineData: TStringList;
    FMapFileBase: DWORD;
    FExceptAddress: DWORD;
    FExceptLineNumber: Integer;
    FExceptMethodName: string;
    FExceptUnitName: string;
    FExceptionAnalyzed: Boolean;
    procedure SetMapFileName(const Value: string);
    procedure LoadMapFile;
  protected
  public
    constructor Create;
    destructor Destroy; override;

    procedure LoadExceptionData(Address: Pointer = nil);

    property MapFileName: string read FMapFileName write SetMapFileName;
    property MapFileBase: DWORD read FMapFileBase write FMapFileBase;
    property ExceptUnitName: string read FExceptUnitName;
    property ExceptMethodName: string read FExceptMethodName;
    property ExceptLineNumber: Integer read FExceptLineNumber;
    property ExceptAddress: DWORD read FExceptAddress;
    property ExceptionAnalyzed: Boolean read FExceptionAnalyzed;
  end;

implementation

{ TMapFile }

constructor TMapFile.Create;
begin
  inherited Create;
  FSegmentData := TStringList.Create;
  FAdressData := TStringList.Create;
  FLineData := TStringList.Create;
  FMapFileName := '';
  FMapFileBase := $00401000;
  FExceptAddress := 0;
  FExceptLineNumber := 0;
  FExceptMethodName := '';
  FExceptUnitName := '';
  FExceptionAnalyzed := False;
end;

destructor TMapFile.Destroy;
begin
  FreeAndNil(FSegmentData);
  FreeAndNil(FAdressData);
  FreeAndNil(FLineData);
  inherited Destroy;
end;

procedure TMapFile.LoadExceptionData(Address: Pointer);
var
  UnitLineDataFound: Boolean;
  I, J, LastLine: Integer;
  Start, Stop, ProcAddr, LineAddr: DWORD;
  Line: string;
begin
  // reset
  FExceptAddress := 0;
  FExceptLineNumber := 0;
  FExceptMethodName := '';
  FExceptUnitName := '';
  FExceptionAnalyzed := False;

  // load address
  if Address = nil then
    Address := ExceptAddr;
  if Address = nil then
    Exit;

  // load and adjust exception address
  FExceptAddress := DWORD(Address) - FMapFileBase;

  // find unit of exception
  I := 0;
  while I < FSegmentData.Count do
  begin
    try
      // check whether address is within unit address limits
      Start := DWORD(StrToInt('0x' + Copy(FSegmentData[I], 7, 8)));
      Stop := Start + DWORD(StrToInt('0x' + Copy(FSegmentData[I], 16, 8)));
      if (Start <= FExceptAddress) and (FExceptAddress < Stop) then
      begin
        Start := Pos('M=', FSegmentData[I]) + 2;
        Stop := Pos('ACBP=', FSegmentData[I]);
        if (Start > 0) and (Stop > 0) then
          FExceptUnitName :=
            Trim(Copy(FSegmentData[I], Start, Stop - Start - 1));
      end;
    except
    end;
    Inc(I);
  end;

  // find function of exception
  I := 0;
  while I < FAdressData.Count do
  begin
    try
      ProcAddr := DWORD(StrToInt('0x' + Copy(FAdressData[I], 7, 8)));
      if ProcAddr >= FExceptAddress then
      begin
        if ProcAddr = FExceptAddress then
          Line := FAdressData[I]
        else
          Line := FAdressData[Pred(I)];
        FExceptMethodName := Trim(Copy(Line, 22, Length(Line)));
        Break;
      end;
    except
    end;
    Inc(I);
  end;

  // find line number of exception
  I := 0;
  UnitLineDataFound := False;
  // search for unit section
  while I < FLineData.Count do
  begin
    if Pos(FExceptUnitName, FLineData[I]) <> 0 then
    begin
      UnitLineDataFound := True;
      Break;
    end;
    Inc(I);
  end;
  if UnitLineDataFound then
  begin
    // search for line number
    LastLine := 0;
    LineAddr := 0;
    Inc(I, 2);
    while I < FLineData.Count do
    begin
      if Pos('Line numbers for', FLineData[I]) <> 0 then
        Break;
      try
        for J := 0 to 3 do
        begin
          LineAddr := StrToInt('0x' + Copy(FLineData[I], J * 20 + 13, 8));
          if LineAddr > FExceptAddress then
            Break;
          LastLine := StrToInt(Trim(Copy(FLineData[I], J * 20 + 1, 6)));
          if LineAddr = FExceptAddress then
            Break;
        end;
      except
      end;
      Inc(I);
    end;
    if LineAddr >= FExceptAddress then
      FExceptLineNumber := LastLine;
  end;

  FExceptionAnalyzed := True;
end;

procedure TMapFile.LoadMapFile;
var
  I: Integer;
begin
  FSegmentData.Clear;
  FAdressData.Clear;
  FLineData.Clear;
  if FileExists(FMapFileName) then
    with TStringList.Create do
    try
      LoadFromFile(FMapFileName);
      // find start of detailed segment block
      I := 0;
      while I < Count do
        if Pos('Detailed map of segments', Strings[I]) <> 0 then
          Break
        else
          Inc(I);
      Inc(I, 2);

      // copy all lines to segment data, until name-address block starts
      while I < Count do
        if Pos('Address         Publics by Name', Strings[I]) <> 0 then
          Break
        else
        begin
          FSegmentData.Add(Strings[I]);
          Inc(I);
        end;

      // find start of value-address block
      while I < Count do
        if Pos('Address         Publics by Value', Strings[I]) <> 0 then
          Break
        else
          Inc(I);
      Inc(I, 3);

      // copy all lines to address data, until line number block starts
      while I < Count do
        if Pos('Line numbers for', Strings[I]) <> 0 then
          Break
        else
        begin
          FAdressData.Add(Strings[I]);
          Inc(I);
        end;

      // copy all remaining lines to line data
      while I < Count do
      begin
        FLineData.Add(Strings[I]);
        Inc(I);
      end;
    finally
      Free;
    end;
end;

procedure TMapFile.SetMapFileName(const Value: string);
begin
  if FMapFileName <> Value then
  begin
    FMapFileName := Value;
    LoadMapFile;
  end;
end;

end.


Component Download: http://www.gatenetwork.com/delphi-samples/d3k/Except.zip