AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

IsObject / IsClass

Ein Thema von choose · begonnen am 3. Feb 2004 · letzter Beitrag vom 22. Nov 2005
 
Benutzerbild von negaH
negaH

Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
 
#12

Re: IsObject / IsClass

  Alt 5. Feb 2004, 20:26
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
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:40 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz