Function MyIsClass(C: TClass; MaxRecursion: Integer = 32): Boolean;
Var B: Boolean;
i, i2: Integer;
PropList: PPropList;
S: PShortString;
C2: TClass;
Label None;
Begin
Result := False;
Try
If (C =
nil)
or (Integer(C)
and $3 <> 0)
Then Goto None;
{***** vmtSelfPtr *****}
//If PInteger(C + vmtSelfPtr)^ = C Then Goto None;
{***** vmtTypeInfo *****}
//If C.ClassInfo <> nil Then Begin
// i := GetPropList(PTypeInfo(C.ClassInfo), PropList);
// B := False;
// If i > 0 Then
// Try
// For i := i - 1 downto 0 do
// For i2 := 1 to Length(PropList[i].Name) do
// If not (PropList[i].Name[i2] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) Then B := True;
// Finally
// FreeMem(PropList);
// End;
// If B Then Goto None;
//End;
{***** vmtClassName *****}
S := PShortString(PPointer(Integer(C) + vmtClassName)^);
If Length(S^) < 1
Then Goto None;
For i2 := 1
to Length(S^)
do
If not (S^[i2]
in ['
a'..'
z', '
A'..'
Z', '
0'..'
9', '
_'])
Then Goto None;
{***** vmtInstanceSize *****}
If (TClass(C).InstanceSize < 0)
or (TClass(C).InstanceSize > 1048576)
Then Goto None;
{***** vmtParent *****}
If MaxRecursion = 0
Then Goto None;
S := PShortString(PPointer(Integer(C) + vmtClassName)^);
Result := (S^
{C.ClassName} = '
TObject')
or MyIsClass(TClass(C).ClassParent, MaxRecursion - 1);
None:
Except
End;
End;
Procedure TForm2.Button1Click(Sender: TObject);
Var C: Integer;
MBI: MEMORY_BASIC_INFORMATION;
i: Integer;
Begin
Button1.Hide;
// HInstance entspricht der Startspeicheradresse der EXE im RAM
// der erste Speicherblock ist irgendwas Anderes
// (eventuell enthält er die API-Funktionszeiger und globalen Variablen? )
VirtualQuery(Pointer(HInstance), MBI, SizeOf(MBI));
// der zweite Speicherblock dürfte die Codesection sein
VirtualQuery(Pointer(Integer(MBI.BaseAddress) + MBI.RegionSize), MBI, SizeOf(MBI));
For C := Integer(MBI.BaseAddress) - vmtSelfPtr
to Integer(MBI.BaseAddress) + MBI.RegionSize - SizeOf(TClass)
do Begin
If MyIsClass(TClass(C))
Then Memo1.Lines.Add(Format('
$%.8d %s', [C, TClass(C).ClassName]));
If C
and $FF = 0
Then Begin
Caption := IntToStr(Integer(MBI.BaseAddress) + MBI.RegionSize - SizeOf(TClass) - C);
Application.ProcessMessages;
End;
End;
Caption := '
fertig';
End;