Как получить список published методов класса

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Ответить
napalmus
незнакомец
Сообщения: 8
Зарегистрирован: 28.03.2012 02:26:28

Как получить список published методов класса

Сообщение napalmus »

Это какая то чёрная дыра. Полдня убил в копаниях.
Для Delphi в интернетах есть куча примеров как это сделать.
Вот один из них:

Код: Выделить всё

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure GetMethodNames(aClass: TClass; List: TStrings);
type
 TMethodTable = packed record
   Count: SmallInt;
 //[...methods...]
 end;
var
 aTable : ^TMethodTable;
 aName  : ^ShortString;
 K      : Integer;
begin
 List.BeginUpdate;
 try
   while aClass <> nil do
   begin
     asm
       mov  EAX, [aClass]
       mov  EAX,[EAX].vmtMethodTable { fetch pointer to method table }
       mov  [aTable], EAX
     end;
     if aTable <> nil then
     begin
       aName  := Pointer(PChar(aTable) + 8);
       for K := 1 to aTable.Count do
       begin
         if List.IndexOf (aName^) < 0 then
           List.Add (aName^);
         aName := Pointer(PChar(aName) + length(aName^) + 7)
       end;
     end;
     aClass := aClass.ClassParent;
   end;
 finally
   List.EndUpdate;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
 SL:TStringList;
begin
 SL:=TStringList.Create;
 try
   GetMethodNames(TForm1, SL);
   ShowMessage(SL.Text);
 finally
   SL.Free;
 end;
end;

end.


Но если попробовать провернуть этот фокус в Лазаре, фиг там. Показывает либо иероглифы (это если подключить и вывести в консоль), либо один символ 'B' (в ShowMessage), при чём не важно какие методы есть в классе, я пробовал для простого тестового класса (не забыл про опцию {$M+}) в котором нет методов с началом на символ 'B', всё равно выводит 'B'. 'B' я так понял это просто мусор. На Дельфях пример рабочий, правда надо PChar заменить на PAnsiChar (это для Delphi XE).
Помогите люди добрые, как побороть этого зверя?
P.S.
Если вдруг важно, перевожу проект с Delphi на Lazarus и в нём есть модуль авторегистрации функций для использования в биндинге скриптового языка Lua. Функций в классе до чёрта, и периодически класс будет расширяться, потому желательно чтоб работал авторегистратор (в Делфях всё путём).
Использую Lazarus 0.9.30.4 r35940 FPC 2.6.0 i386-win32-win32/win64.
Аватара пользователя
Sergei I. Gorelkin
энтузиаст
Сообщения: 1409
Зарегистрирован: 24.07.2005 14:40:41
Откуда: Зеленоград

Сообщение Sergei I. Gorelkin »

Код: Выделить всё

procedure GetMethodList(AClass: TClass; AList: TStrings);
type
  TMethodNameRec = packed record
    name : pshortstring;
    addr : pointer;
  end;

  TMethodNameTable = packed record
    count : dword;
    entries : packed array[0..0] of TMethodNameRec;
  end;

  pMethodNameTable =  ^TMethodNameTable;

var
  methodTable : pMethodNameTable;
  i : dword;
  vmt: TClass;
  idx: integer;
begin
  AList.Clear;
  vmt := aClass;
  while assigned(vmt) do
  begin
    methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
    if assigned(MethodTable) then
    begin
      for i := 0 to MethodTable^.count - 1 do
      begin
        idx := aList.IndexOf(MethodTable^.entries[i].name^);
        if (idx <> - 1) then
        //found overridden method so delete it
          aList.Delete(idx);
        aList.AddObject(MethodTable^.entries[i].name^, TObject(MethodTable^.entries[i].addr));
      end;
    end;
    vmt := pClass(pointer(vmt) + vmtParent)^;
  end;
end;

Это процедура из модуля fcl-fpcunit/src/testutils.pp, если что.
napalmus
незнакомец
Сообщения: 8
Зарегистрирован: 28.03.2012 02:26:28

Сообщение napalmus »

Я знал! Я надеялся! Я верил!
Спасибо, большое :)
Стыдно мне...я как то не догадался что можно в модулях глянуть.
Кстати, Сергей, читаю ваши статьи на блоге, очень доступно и понятно пишите, за что тоже спасибо.
Аватара пользователя
Sergei I. Gorelkin
энтузиаст
Сообщения: 1409
Зарегистрирован: 24.07.2005 14:40:41
Откуда: Зеленоград

Сообщение Sergei I. Gorelkin »

Хм, я пока еще ни одной статьи не написал, и блогов не веду (хотя может и стоило бы)...
napalmus
незнакомец
Сообщения: 8
Зарегистрирован: 28.03.2012 02:26:28

Сообщение napalmus »

Ой, я забыл сказать, я из будущего. Сергей, вы обязательно будете писать, доступно и понятно.
Пишите, Сергей!

Добавлено спустя 1 час 42 минуты 28 секунд:
:) Извините за дезинформацию, у меня почему то наглухо запечатлелась в памяти ваша аватарка в связке со статьями и блогами по Delphi. А сейчас вот пытался найти и по нулям :)
Спасибо ещё раз за подсказку.
Ответить