IsObject / IsClass

[negaH]

Hier der Code um über die TypInfo's zu iterieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Buttons, StdCtrls, TypInfo;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
    function DoRTTI(Info: PTypeInfo): Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TEnumTypeInfoCallback = function(UserData: Pointer; Info: PTypeInfo): Boolean; register;

function GetBaseOfCode(Module: hModule; var CodeStart, CodeEnd: PChar): Boolean;
asm // get Codesegment pointers, check if module is a valid PE
       PUSH  EDI
       PUSH  ESI
       AND   EAX,not 3
       JZ    @@2
       CMP   Word Ptr [EAX],'ZM';
       JNE   @@1
       MOV   ESI,[EAX + 03Ch]
       CMP   Word Ptr [ESI + EAX],'EP'
       JNE   @@1
       MOV   EDI,[EAX + ESI + 014h + 008h]
       ADD   EAX,[EAX + ESI + 014h + 018h]
       ADD   EDI,EAX
       MOV   [EDX],EAX
       MOV   [ECX],EDI
       XOR   EAX,EAX
@@1:   SETE  AL
@@2:   POP   ESI
       POP   EDI
end;

function EnumTypeInfo(Module: hModule; Callback: TEnumTypeInfoCallback; UserData: Pointer): PTypeInfo;
// copyright (c) 1998 Hagen Reddmann
var
  P,E,K,N: PChar;
  L: Integer;
begin
  Result := nil;
  if Assigned(Callback) then
  try
    if GetBaseOfCode(Module, P, E) then
      while P < E do
      begin
        DWord(P) := DWord(P) and not 3;
        K := P + 4;
        if (PDWord(P)^ = DWord(K)) and (PByte(K)^ > 0) and (PByte(K)^ < 18) then // Info.Kind in ValidRange.D6
        begin
          L := PByte(K + 1)^;  // length Info.Name
          N := K + 2;          // @Info.Name[1]
          if (L > 0) and (N^ in ['_', 'a'..'z', 'A'..'Z']) then  // valid ident ??
          begin
            repeat
              Inc(N);
              Dec(L);
            until (L = 0) or not (N^ in ['_', 'a'..'z', 'A'..'Z', '0'..'9']);
            if L = 0 then // length and ident valid
              if Callback(UserData, Pointer(K)) then // tell it and if needed abort iteration
              begin
                Result := Pointer(K);
                Exit;
              end else K := N;
          end;
        end;
        P := K;
      end;
  except
  end;
end;

function TForm1.DoRTTI(Info: PTypeInfo): Boolean;
var
  P: PTypeData;
begin
  Result := False;
//  if Info.Kind = tkClass then
  begin
//    P := GetTypeData(Info);
//    if P.ClassType.InheritsFrom(TCustomForm) then
      ListBox1.Items.Add(Info.Name{ + ', ' + P.UnitName});
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  EnumTypeInfo(MainInstance, @TForm1.DoRTTI, Self);
end;

end.

Gruß Hagen