Answer:
unit xDebug;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
contnrs;
type
TPtrDef = class
public
Offset: LongInt;
Base: LongInt;
function Addr: LongInt;
end;
TPublicDef = class(TPtrDef)
public
PublicName: String;
end;
TLineDef = class(TPtrDef)
public
UnitName: String;
LineNo: Integer;
end;
_StackRec = record
LastEBP: Pointer;
CallerAddr: Pointer;
end;
TxDebug = class(TComponent)
private
{ Private declarations }
FStackRec: _StackRec;
FFileName: TFileName;
FActive: Boolean;
{ error defenition }
FAddress: Pointer;
FUnitName: String;
FLineNo: Integer;
FPublicName: String;
procedure SetFileName(const Value: TFileName);
procedure SetActive(Value: Boolean);
procedure SetAddress(Value: Pointer);
protected
{ Protected declarations }
FPublics: TObjectList;
FLines: TObjectList;
procedure ClearMap; virtual;
procedure LoadMap; virtual;
procedure LoadPublics(var F: TextFile); virtual;
procedure LoadLines(var F: TextFile); virtual;
procedure ParsePublic(const S: String); virtual;
procedure ParseLine(const S, UnitName: String); virtual;
function SearchPtr(Addr: Pointer; FList: TObjectList): TPtrDef; virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CallStack_Init;
function CallStack_Next: Boolean;
{ PROPERTIES }
property UnitName: String read FUnitName;
property PublicName: String read FPublicName;
property LineNo: Integer read FLineNo;
property Address: Pointer read FAddress write SetAddress;
published
{ Published declarations }
{ PROPERTIES }
property FileName: TFileName read FFileName write SetFileName;
property Active: Boolean read FActive write SetActive;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Legionary', [TxDebug]);
end;
////////////////////////////////////////////////////////////////////////////////
// SortAddr
function SortAddr(Item1, Item2: Pointer): Integer;
begin
Result:= TPtrDef(Item1).Addr - TPtrDef(Item2).Addr;
end;
////////////////////////////////////////////////////////////////////////////////
// TPtrDef
function TPtrDef.Addr;
begin
Result:= $00400000 + $1000*Base + Offset;
end;
////////////////////////////////////////////////////////////////////////////////
// TxDebug
constructor TxDebug.Create;
begin
inherited;
FPublics:= TObjectList.Create(True);
FLines:= TObjectList.Create(True);
FActive:= false;
FFileName:= '';
FAddress:= nil;
FPublicName:= '';
FUnitName:= '';
FLineNo:= 0;
end;
destructor TxDebug.Destroy;
begin
FPublics.Free;
FLines.Free;
inherited;
end;
procedure TxDebug.SetFileName;
begin
Assert(not FActive);
if FFileName<>Value then
begin
FFileName:= Value;
ClearMap;
end;
end;
procedure TxDebug.ClearMap;
begin
FPublics.Clear;
FLines.Clear;
end;
procedure TxDebug.LoadMap;
var
F: TextFile;
begin
AssignFile(F, FFileName);
Reset(F);
try
LoadPublics(F);
Reset(F);
LoadLines(F);
finally
CloseFile(F);
end;
end;
procedure TxDebug.SetActive;
begin
if Value<>FActive then
begin
if Value then
begin
LoadMap;
FActive:= True;
end
else
begin
ClearMap;
FActive:= False;
end;
end;
end;
procedure TxDebug.LoadPublics;
const
cStrID = 'Address Publics by Name';
var
S: String;
begin
while not Eof(F) do
begin
ReadLn(F, s);
if Trim(S)=cStrID then Break;
end;
if not Eof(F) then Readln(F, S);
// load publics
while not Eof(F) do
begin
ReadLn(F, S);
if Trim(S)='' then Break;
ParsePublic(S);
end;
FPublics.Sort(@SortAddr);
end;
procedure TxDebug.LoadLines;
const
cStrID = 'Line numbers for';
var
S, SS: String;
begin
// Address Publics by Name
while not Eof(F) do
begin
while not Eof(F) do
begin
ReadLn(F, S);
if Copy(S, 1, Length(cStrID))=cStrID then Break;
end;
SS:= Copy(S, Length(cStrID) + 1, Pos('(', S) - length(cStrID) - 1);
if not Eof(F) then Readln(F, S);
// load publics
while not Eof(F) do
begin
ReadLn(F, S);
if Trim(S)='' then Break;
ParseLine(S, SS);
end;
end;
FLines.Sort(@SortAddr);
end;
procedure TxDebug.ParsePublic;
var
n, l: Integer;
base, off: LongInt;
cap, ss: String;
o: TPublicDef;
begin
l:= Length(s);
if l>0 then
begin
n:= 1;
ss:= '';
while (n <= l) and (s[n]<>':') do
begin
ss:= ss + s[n];
n:= n + 1;
end;
n:= n + 1;
base:= StrToInt('$'+Trim(ss));
ss:= '';
while (n <=l) and (s[n]<>' ') do
begin
ss:= ss + s[n];
n:= n + 1;
end;
n:= n + 1;
off:= StrToInt('$'+Trim(ss));
ss:= '';
while (n <=l) do
begin
ss:= ss + s[n];
n:= n + 1;
end;
cap:= Trim(ss);
// finally insert object
o:= TPublicDef.Create;
o.PublicName:= cap;
o.Offset:= off;
o.Base:= base;
FPublics.Add(o);
end;
end;
procedure TxDebug.ParseLine;
var
n, l: Integer;
ss: String;
off, base, line: LongInt;
o: TLineDef;
begin
l:= Length(s);
if l>0 then
begin
n:= 1;
while n <= l do
begin
// skip spaces
while (n <= l) and (s[n]=' ') do n:=n+1;
// scan line id
ss:= '';
while (n <= l) and (s[n]<>' ') do
begin
ss:= ss + s[n];
n:= n + 1;
end;
line:= StrToInt(Trim(ss));
n:= n + 1;
ss:= '';
while (n <=l) and (s[n]<>':') do
begin
ss:= ss + s[n];
n:= n + 1;
end;
base:= StrToInt('$'+Trim(ss));
n:= n + 1;
ss:= '';
while (n <= l) and (s[n]<>' ') do
begin
ss:= ss + s[n];
n:= n + 1;
end;
off:= StrToInt('$'+Trim(ss));
n:= n + 1;
// add object
o:= TLineDef.Create;
o.Base:= base;
o.Offset:= off;
o.UnitName:= UnitName;
o.LineNo:= line;
FLines.Add(o);
end;
end;
end;
function TxDebug.SearchPtr;
var
n, nn: Integer;
o: TPtrDef;
b: Boolean;
begin
Result:= nil;
b:=false;
nn:=-1;
for n:=0 to FList.Count-1 do
begin
o:= TPtrDef(FList.Items[n]);
if o.Addr=LongInt(Addr) then
begin
nn:= n;
Break;
end;
if b and (o.Addr > LongInt(Addr)) then
begin
nn:= n - 1;
Break;
end;
b:= o.Addr < LongInt(Addr);
end;
if nn>-1 then
Result:= TPtrDef(FList.Items[nn]);
end;
procedure TxDebug.SetAddress;
var
pub: TPublicDef;
line: TLineDef;
begin
Assert(FActive);
FAddress:= Value;
pub:= TPublicDef(SearchPtr(FAddress, FPublics));
line:= TLineDef(SearchPtr(FAddress, FLines));
if Assigned(pub) then
FPublicName:= pub.PublicName;
if Assigned(line) then
begin
FUnitName:= line.UnitName;
FLineNo:= line.LineNo;
end;
end;
procedure TxDebug.CallStack_Init;
var
rec: ^_StackRec;
begin
rec:= @FStackRec;
asm
push ebx
mov eax, rec
mov ebx, ss:[ebp] // prior_ebp
mov [eax], ebx
mov ebx, ss:[ebp+4] // caller_addr
mov [eax+4], ebx
pop ebx
end;
SetAddress(FStackRec.CallerAddr);
end;
function TxDebug.CallStack_Next;
var
rec: ^_StackRec;
begin
rec:= @FStackRec;
asm
push ebx
push ebp
mov eax, rec
mov ebx, [eax] // prior_ebp
mov ebp, ebx // save prior_ebp in ebp
mov ebx, ss:[ebp] // prior_ebp
mov [eax], ebx
mov ebx, ss:[ebp+4] // caller_addr
mov [eax+4], ebx
pop ebp
pop ebx
end;
SetAddress(FStackRec.CallerAddr);
Result:= CompareText(PublicName, 'TlsLast')=0;
end;
end.
|
Sign Up
