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. (Happy Birthday Christian S.) 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 D3K 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 © 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 © 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 © 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.
Have fun,
Daniel Wischnewski
Sign Up
