Как прочитать весь список Published методов?

Материал из DRKB

Как прочитать весь список Published методов?[править | править код]

procedure EnumMethods(aClass: TClass; lines: TStrings);
  type
    TMethodtableEntry = packed Record
      len: Word;
      adr: Pointer;
      name: ShortString;
  end;
  { Note: name occupies only the size required, so it is not a true shortstring! The actual
  entry size is variable, so the method table is not an array of TMethodTableEntry! }

var
  pp: ^Pointer;
  pMethodTable: Pointer;
  pMethodEntry: ^TMethodTableEntry;
  i, numEntries: Word;
begin
  if aClass = nil then
    Exit;
  pp := Pointer(Integer(aClass) + vmtMethodtable);
  pMethodTable := pp^;
  lines.Add(format('Class %s: method table at %p', [aClass.Classname, pMethodTable ]));
  if pMethodtable <> nil then
  begin
    { first word of the method table contains the number of entries }
    numEntries := PWord(pMethodTable)^;
    lines.Add(format('  %d published methods', [numEntries]));
    { make pointer to first method entry, it starts at the second word of the table }
    pMethodEntry := Pointer(Integer(pMethodTable) + 2);
    for i := 1 to numEntries do
    begin
      with pMethodEntry^ do
        lines.Add(format('  %d: len: %d, adr: %p, name: %s', [i, len, adr, name]));
      { make pointer to next method entry }
      pMethodEntry := Pointer(Integer(pMethodEntry) + pMethodEntry^.len);
    end;
  end;
    EnumMethods(aClass.ClassParent, lines);
end;


procedure TForm2.Button1Click(Sender: TObject);
begin
  memo1.clear;
  EnumMethods(Classtype, memo1.lines);
end;


Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00269



function GetComponentProperties(Instance: TPersistent; AList: TStrings): Integer;
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
begin
  Result := 0;
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for I := 0 to Count - 1 do
      begin
        PropInfo := PropList^[I];
        if PropInfo = nil then
          Break;
        if IsStoredProp(Instance, PropInfo) then
        begin
          {
          case PropInfo^.PropType^.Kind of
            tkInteger:
            tkMethod:
            tkClass:
            ...
          end;
          }
        end;
        Result := AList.Add(PropInfo^.Name);
      end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;
end;


Author: Grega Loboda
ID: 00270



uses
  TypInfo

procedure ListProperties(AInstance: TPersistent; AList: TStrings);
var
  i: integer;
  pInfo: PTypeInfo;
  pType: PTypeData;
  propList: PPropList;
  propCnt: integer;
  tmpStr: string;
begin
  pInfo := AInstance.ClassInfo;
  if (pInfo = nil) or (pInfo^.Kind <> tkClass) then
    raise Exception.Create('Invalid type information');
  pType := GetTypeData(pInfo);  {Pointer to TTypeData}
  AList.Add('Class name: ' + pInfo^.Name);
  {If any properties, add them to the list}
  propCnt := pType^.PropCount;
  if propCnt > 0 then
  begin
    AList.Add(EmptyStr);
    tmpStr := IntToStr(propCnt) + ' Propert';
    if propCnt > 1 then
      tmpStr := tmpStr + 'ies'
    else
      tmpStr := tmpStr + 'y';
    AList.Add(tmpStr);
    FillChar(tmpStr[1], Length(tmpStr), '-');
    AList.Add(tmpStr);
    {Get memory for the property list}
    GetMem(propList, sizeOf(PPropInfo) * propCnt);
    try
      {Fill in the property list}
      GetPropInfos(pInfo, propList);
      {Fill in info for each property}
      for i := 0 to propCnt - 1 do
        AList.Add(propList[i].Name+': '+propList[i].PropType^.Name);
    finally
      FreeMem(propList, sizeOf(PPropInfo) * propCnt);
    end;
  end;
end;


function GetPropertyList(AControl: TPersistent; AProperty: string): PPropInfo;
var
  i: integer;
  props: PPropList;
  typeData: PTypeData;
begin
  Result := nil;
  if (AControl = nil) or (AControl.ClassInfo = nil) then
    Exit;
  typeData := GetTypeData(AControl.ClassInfo);
  if (typeData = nil) or (typeData^.PropCount = 0) then
    Exit;
  GetMem(props, typeData^.PropCount * SizeOf(Pointer));
  try
    GetPropInfos(AControl.ClassInfo, props);
    for i := 0 to typeData^.PropCount - 1 do
    begin
      with Props^[i]^ do
        if (Name = AProperty) then
          result := Props^[i];
    end;
  finally
    FreeMem(props);
  end;
end;


And calling this code by:

ListProperties(TProject(treeview1.items[0].data), memo3.lines);


My tProject is defined as

type
   TProject = class(tComponent)
   private
     FNaam: string;
     procedure SetNaam(const Value: string);
   public
     constructor Create(AOwner: tComponent);
     destructor Destroy;
   published
     property Naam: string read FNaam write SetNaam;
   end;

Also note the output, there seem to be 2 standard properties (Name and Tag) !

 Memo3
 Class name: TProject
 
 3 Properties
 -------------------
 Name: TComponentName
 Tag: Integer
 Naam: String


Author: Ronan van Riet
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00271