Mega Code Archive
Displaying Custom Exceptions Dialogs and write Exceptions to the NT Event Log (component set)
<![CDATA[
Title: Displaying Custom Exceptions Dialogs and write Exceptions to the NT Event Log (component set)
Question: 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. (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) 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 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 and (FExceptAddress 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 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 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 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 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 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 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 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 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
]]>