Ver Mensaje Individual
  #4  
Antiguo 09-06-2006
rounin rounin is offline
Miembro
 
Registrado: sep 2005
Posts: 43
Reputación: 0
rounin Va por buen camino
En principio es possible obtener los "published" metodos de una clase.
Pero no es possible obtener la lista de argumentos.
(Eso es possible, por ejemplo, para metodos de seccion "automated").

Código Delphi [-]
unit main;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  PubMeth;
type
  TForm1 = class(TForm)
    BShowMethods: TButton;
    ListBox1: TListBox;
    procedure BShowMethodsClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  {$M+}
  TTest1 = class
  published
    procedure Test1; virtual; abstract;
  end;
  TTest2 = class(TTest1)
  published
    procedure Test2; virtual; abstract;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BShowMethodsClick(Sender: TObject);
var
  MethodIterator: TPublishedMethodIterator;
  Cls: TClass;
begin
  ListBox1.Clear;
  MethodIterator := TPublishedMethodIterator.Create;
  Cls := TTest2; //ClassType;
  try
    with MethodIterator do
    begin
       while Cls <> nil do
       begin
        Init(Cls);
        ListBox1.Items.Add(Format('%s, %d methods',[TClass(VMT).ClassName, GetMethodCount]));
        First;
        while (Current <> nil) do
        begin
          ListBox1.Items.Add(Format('     %s: $%p',[Current^.Name, Current^.Address]));
          Next;
        end;
         Cls := Cls.ClassParent;
       end;
    end;
  finally
    MethodIterator.Free;
  end;
end;
end.
 
{-----------------------------------------------------------------------}
 
unit PubMeth; 
interface
uses
 Classes, TypInfo;
type
 PVmtMethod = ^TVmtMethod;
 TVmtMethod = packed record
   Size: Word;
   Address: Pointer;
   Name: ShortString;
 end;
 PVmtMethodTable = ^TVmtMethodTable;
 TVmtMethodTable = packed record
   Count: Word;
   Methods: array [0..MaxListSize] of byte;
   {    Methods : array [0..Count] of TVmtMethod;}
 end;
 TPublishedMethodIterator = class
 private
   FVMT: Pointer;
   FMethodTable: PVmtMethodTable;
   FCurrent: PVmtMethod;
   FCurrentIndex: Integer;
   function CurrentLength: Integer;
 public
   property VMT: Pointer read FVMT;
   property Current: PVmtMethod read FCurrent;
   function GetMethodCount: Integer;
   procedure Init(AClass: TClass);
   function First: PVmtMethod;
   function Next: PVmtMethod;
 end;
function OffsetPtr(P: Pointer; Offset: Integer): Pointer;
implementation
function OffsetPtr(P: Pointer; Offset: Integer): Pointer;
begin
  Integer(Result) := Integer(P) + OffSet;
end;
{ TPublishedMethodIterator }
function TPublishedMethodIterator.GetMethodCount: Integer;
begin
  Result := 0;
  if not Assigned(FMethodTable) then Exit;
  Result := FMethodTable^.Count;
end;
procedure TPublishedMethodIterator.Init(AClass: TClass);
begin
  FMethodTable := nil;
  FVMT := Pointer(AClass);
  FMethodTable := Pointer( OffsetPtr(FVMT, vmtMethodTable)^ );
  FCurrent := nil;
end;
function TPublishedMethodIterator.First: PVmtMethod;
begin
  Result := nil;
  FCurrentIndex := 0;
  if not Assigned(FMethodTable) then Exit;
  FCurrent := Pointer(@FMethodTable.Methods[0]);
  Result := FCurrent;
end;
function TPublishedMethodIterator.CurrentLength: Integer;
begin
  Result := 0;
  if not Assigned(FCurrent) then Exit;
  Result := Current^.Size; // SizeOf(Word) + SizeOf(Pointer) + Length(Current^.Name) + 1;
end;
function TPublishedMethodIterator.Next: PVmtMethod;
begin
  Result := nil;
  if not Assigned(FMethodTable) then Exit;
  if FCurrentIndex + 1 >= GetMethodCount then
  begin
    FCurrent := nil;
  end
  else
  begin
    FCurrent := OffsetPtr(FCurrent, CurrentLength);
    Inc(FCurrentIndex);
  end;
  Result := FCurrent;
end;
end.
Responder Con Cita