Hallo,
nach einiger Zeit kommt von mir auch wieder einmal eine Frage.
Ich möchte bei einer Exception einen StackTrace ausgeben, dabei aber auch die Komponenten mit ausgeben, zu denen die Methoden gehören.
Ich habe dafür die JclDebug.pas benutzt und erweitert. Es funktioniert auch. Nur ist mir klar geworden, dass mir wohl doch nicht so ganz klar ist was da auf dem Stack liegt. Bzw. wie ich herausfinde, ob da ein Objekt liegt (falls das geht).
Nun, ich poste einmal wie ich es versucht habe. Zunächst wollte ich feststellen, ob es sich um ein Objekt handelt, ohne dabei aber Exceptions auszulösen:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
| function IsValidObject(Obj: TObject): Pointer;
type
PPVmt = ^PVmt;
PVmt = ^TVmt;
TVmt = record
SelfPtr : TClass;
Other : array[0..17] of pointer;
end;
var
Vmt: PVmt;
begin
if Assigned(Obj) and (Integer(Obj) > $FFFF) and (Integer(Obj) < $FFFFFF)
and not IsBadReadPtr(Obj, 4) and not IsBadReadPtr(PPointer(Obj)^, 4) then
try
Result := Obj;
Vmt := PVmt(Obj.ClassType);
Dec(Vmt);
if IsBadReadPtr(Vmt, 4) or IsBadReadPtr(PPointer(Vmt)^, 4) or (Obj.ClassType <> Vmt.SelfPtr) then
Result := nil;
except
Result := nil;
end
else
Result := nil;
end; |
Die Prüfung der Bereiche innerhalb der beiden Konstanten funktioniert zwar in meinen Tests, aber so wirklich gefallen tut es mir nicht. Ich habe aber erst einmal auch nicht weiter darauf geschaut.
Dann zu dem Problem selbst, dafür bin ich in TJclStackInfoList.TraceStackRaw gegangen, der neue Teil ist markiert:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
| type
TStackInfo = record
CallerAddr: TJclAddr;
Level: DWORD;
CallerFrame: TJclAddr;
DumpSize: DWORD;
ParamSize: DWORD;
ParamPtr: PDWORD_PTRArray;
CallerObj: TJclAddr;
case Integer of
0:
(StackFrame: PStackFrame);
1:
(DumpPtr: PJclByteArray);
end;
procedure TJclStackInfoList.TraceStackRaw;
var
StackInfo: TStackInfo;
StackPtr: PJclAddr;
ObjectPtr: PJclAddr;
PrevCaller: TJclAddr;
CallInstructionSize: Cardinal;
StackTop: TJclAddr;
begin
Capacity := 32;
if DelayedTrace then
begin
if not Assigned(FStackData) then
Exit;
StackPtr := PJclAddr(FStackData);
end
else
begin
if BaseOfStack = 0 then
BaseOfStack := TJclAddr(GetStackPointer);
StackPtr := PJclAddr(BaseOfStack);
end;
StackTop := TopOfStack;
if Count > 0 then
StackPtr := SearchForStackPtrManipulation(StackPtr, Pointer(Items[0].StackInfo.CallerAddr));
ResetMemory(StackInfo, SizeOf(StackInfo));
PrevCaller := 0;
while (TJclAddr(StackPtr) < StackTop) and (inherited Count <> MaxStackTraceItems) do
begin
StackInfo.CallerObj := 0;
if ValidCallSite(StackPtr^, CallInstructionSize) and (StackPtr^ <> PrevCaller) then
begin
StackInfo.CallerAddr := StackPtr^ - CallInstructionSize;
PrevCaller := StackPtr^;
Inc(StackInfo.Level);
ObjectPtr := StackPtr;
Inc(ObjectPtr);
if Assigned(ValidateObj(TObject(ObjectPtr^))) then
StackInfo.CallerObj := ObjectPtr^;
StoreToList(StackInfo);
StackPtr := SearchForStackPtrManipulation(StackPtr, Pointer(StackInfo.CallerAddr));
end;
Inc(StackPtr);
end;
if Assigned(FStackData) then
begin
FreeMem(FStackData);
FStackData := nil;
end;
end; |
Ich erhöhe also einfach den Pointer und schaue ob ich dahinter ein Objekt finde.
Ja, geht das besser? Oder geht es nur so mit raten und ausprobieren?
Wie gesagt: Funktionieren tut es und Schutzverletzungen kommen auch keine mehr dank IsBadReadPtr. Ich würde es aber gerne besser machen, wenn es geht.
Vielen Dank,
schönen Gruß,
Sebastian
