| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Список методов у объекта [D7]

Sectey ©   (2004-08-03 15:38:00) 

Есть ли возможность получить список методов объектов?

---

Sectey   (2004-08-03 16:54:00) [1]

>Игорь Шевченко ©
Это все вам :-))))

---

Sectey   (2004-08-03 16:54:00) [2]

Спасибо большое, все очень понятно. Большой поклон профессионалу.

---

Sandman25   (2004-08-03 16:45:00) [3]

[13] Игорь Шевченко ©   (03.08.04 16:33)

Ого. Впечатляет.

---

Игорь Шевченко   (2004-08-03 16:35:00) [4]

И второй юнит:

unit ChildForm;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, ParentForm, ExtCtrls;

type
 TfChild = class(TfParent)
   Timer: TTimer;
   procedure TimerTimer(Sender: TObject);
 end;

var
 fChild: TfChild;

implementation

{$R *.dfm}

procedure TfChild.TimerTimer(Sender: TObject);
begin
 //Beep;
end;

end.


и его предок:

unit ParentForm;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TfParent = class(TForm)
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormActivate(Sender: TObject);
 end;

var
 fParent: TfParent;

implementation

{$R *.dfm}

procedure TfParent.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

procedure TfParent.FormActivate(Sender: TObject);
begin
 ShowMessage('I am activated');
end;

end.


---

Игорь Шевченко   (2004-08-03 16:33:00) [5]

Насчет как добраться, может, поможет код:


unit main;

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

type
 TfMain = class(TForm)
   ListBox1: TListBox;
   Button3: TButton;
   procedure Button3Click(Sender: TObject);
 private
   procedure SpyMethods(AClass: TClass; Strings: TStrings);
   procedure SpyRootComponentMethods(AClass: TObject; Strings: TStrings);
   procedure SpyComponentMethods(AClass: TObject; Strings, Methods: TStrings);
   procedure SpyInstanceMethods(AClass: TObject; Strings, Methods: TStrings);
   function ParseMethodProp(AProp: PPropInfo;
     const MethodName: string): string; overload;
   function ParseMethodProp(AProp: PPropInfo): string; overload;
 end;

var
 fMain: TfMain;

implementation
uses
 ChildForm;

{$R *.dfm}

{ TfMain }

type
 TMethodDesc = packed record
   MethodDescSize: Word;
   MethodAddress: Pointer;
   MethodName: ShortString;
 end;
 PMethodDesc = ^TMethodDesc;

 TMethodTable = packed record
   MethodCount: Word;
   Data: TMethodDesc;
 end;
 PMethodTable = ^TMethodTable;
 PPMethodTable = ^PMethodTable;

procedure TfMain.SpyMethods(AClass: TClass; Strings: TStrings);
var
 Methods: PMethodTable;
 MethodDesc: PMethodDesc;
 I: Integer;
begin
 Methods := PPMethodTable(PChar(AClass) + vmtMethodTable)^;
 if Assigned(Methods) then begin
   MethodDesc := @Methods^.Data;
   for I:=0 to Pred(Methods^.MethodCount) do begin
     Strings.AddObject(
       Format('%s.%s', [AClass.ClassName, MethodDesc^.MethodName]),
         TObject(MethodDesc^.MethodAddress));
     MethodDesc := PMethodDesc(PChar(MethodDesc) + MethodDesc^.MethodDescSize);
   end;
 end;
 if AClass.ClassParent <> nil then
   SpyMethods(AClass.ClassParent, Strings);
end;

function MethodKindToString (const Value: TMethodKind): string;
const
 MethodKindNames: array[TMethodKind] of string = ('procedure', 'function',
   'constructor', 'destructor', 'class procedure', 'class function',
   'procedure', 'function');
begin
 Result := MethodKindNames[Value];
end;

type
 TParamDesc = packed record
   Flags: TParamFlags;
   ParamName: ShortString;
   TypeName: ShortString;
 end;
 PParamDesc = ^TParamDesc;

function TfMain.ParseMethodProp(AProp: PPropInfo;
 const MethodName: string): string;
var
 MethodTypeData: PTypeData;
 ParamCount: Integer;
 ParamDesc: PParamDesc;
 Param, Params: string;
 ResultType: PShortString;
 I: Integer;
 TypeName: PShortString;
begin
 MethodTypeData := GetTypeData(AProp^.PropType^);
 ParamCount := MethodTypeData^.ParamCount;
 ParamDesc := @MethodTypeData^.ParamList;
 ResultType := PShortString(ParamDesc);
 for I:=0 to Pred(ParamCount) do begin
   if pfVar in ParamDesc^.Flags then
     Param := 'var '
   else if pfConst in ParamDesc^.Flags then
     Param := 'const '
   else
     Param := '';
   TypeName := PShortString(PChar(ParamDesc) + SizeOf(TParamFlags) +
     Length(ParamDesc^.ParamName) + SizeOf(Char));
   if pfArray in ParamDesc^.Flags then
     Param := Param + Format('%s: array of %s', [ParamDesc^.ParamName,
       TypeName^])
   else
     Param := Param + Format('%s: %s', [ParamDesc^.ParamName,
       TypeName^]);
   if I <> 0 then
     Params := Params + '; ';
   Params := Params + Param;
   ParamDesc := PParamDesc(PChar(ParamDesc) + SizeOf(TParamFlags) +
     Length(ParamDesc^.ParamName) + Length(TypeName^) +
     SizeOf(Char) * 2);
   ResultType := PShortString(ParamDesc);
 end;
 if Length(Params) <> 0 then
   Params := '(' + Params + ')';
 if MethodTypeData^.MethodKind in
     [mkFunction, mkClassFunction, mkSafeFunction] then
   Params := Format('%s: %s;', [Params, ResultType^])
 else
   Params := Params + ';';
 if MethodTypeData^.MethodKind in [mkSafeProcedure, mkSafeFunction] then
   Params := Params + 'safecall;';
 Result := Format('%s %s: %s', [
   MethodKindToString(MethodTypeData^.MethodKind), MethodName, Params]);
end;

function TfMain.ParseMethodProp(AProp: PPropInfo): string;
begin
 Result := ParseMethodProp(AProp, AProp^.Name);
end;

procedure TfMain.SpyInstanceMethods(AClass: TObject;
 Strings, Methods: TStrings);

 function GetFullMethodName(const Methods: TStrings; Address: Pointer): string;
 var
   I: Integer;
 begin
   for I:=0 to Pred(Methods.Count) do
     if Pointer(Methods.Objects[I]) = Address then begin
       Result := Methods[I];
       Break;
     end;
 end;

var
 Props: TPropList;
 I: Integer;
 NumMethods: Integer;
 Method: TMethod;
 FullMethodName: string;
begin
 NumMethods := GetPropList(AClass.ClassInfo, tkMethods, @Props);
 for I:=0 to Pred(NumMethods) do begin
   Method := GetMethodProp(AClass, Props[I]);
   if Assigned(Method.Code) then begin
     FullMethodName := GetFullMethodName(Methods, Method.Code);
     if Length(FullMethodName) <> 0 then
       Strings.Add (ParseMethodProp(Props[I], FullMethodName));
   end;
 end;
end;

procedure TfMain.Button3Click(Sender: TObject);
var
 Strings: TStrings;
begin
 Strings := TStringList.Create;
 try
   SpyRootComponentMethods(fChild, Strings);
   ListBox1.Items.Assign(Strings);
 finally
   Strings.Free;
 end;
end;

procedure TfMain.SpyComponentMethods(AClass: TObject;
 Strings, Methods: TStrings);
var
 I: Integer;
begin
 SpyInstanceMethods(AClass, Strings, Methods);
 if AClass is TComponent then
   for I:=0 to Pred(TComponent(AClass).ComponentCount) do
     SpyComponentMethods(TComponent(AClass).Components[I], Strings, Methods);
end;

procedure TfMain.SpyRootComponentMethods(AClass: TObject;
 Strings: TStrings);
var
 MethodStrings: TStrings;
begin
 MethodStrings := TStringList.Create;
 try
   SpyMethods(AClass.ClassType, MethodStrings);
   SpyComponentMethods(AClass, Strings, MethodStrings);
 finally
   MethodStrings.Free;
 end;
end;

end.


---

Sectey   (2004-08-03 16:32:00) [6]

А VMT может здесь помочь?

---

Игорь Шевченко   (2004-08-03 16:31:00) [7]

Sandman25 ©   (03.08.04 16:11)

А он присуствует в списке methods в VMT ?

---

Sectey   (2004-08-03 16:30:00) [8]

Извените но мне кажется, что TypInfo.pas здесь не поможет :-(

---

Sandman25   (2004-08-03 16:11:00) [9]

Для проверки сделал TMzButton c published методом. Только не получается разобраться, как до него добраться :(

---

KSergey   (2004-08-03 16:08:00) [10]

> [7] Игорь Шевченко ©   (03.08.04 16:05)
> те, которые являются обработчиками событий (FormCreate,
> и т.д.)

Ну к стати да, признаю. Плохо готовился.

---

Игорь Шевченко   (2004-08-03 16:05:00) [11]

KSergey ©   (03.08.04 15:53) [5]


> А методы Published бывают?


те, которые являются обработчиками событий (FormCreate, и т.д.)

---

Sandman25   (2004-08-03 15:58:00) [12]

[5] KSergey ©   (03.08.04 15:53)

>А методы Published бывают?

Конечно.

---

KSergey   (2004-08-03 15:53:00) [13]

> [2] Sandman25 ©   (03.08.04 15:39)
> Только Published

А методы Published бывают?

---

Sergey Kaminski   (2004-08-03 15:49:00) [14]

Sectey ©   (03.08.04 15:44) [3]
ДА спасибо я понял :-)))

Если это не сарказм, то см. TypInfo.pas

---

Sectey   (2004-08-03 15:44:00) [15]

ДА спасибо я понял :-)))

---

KSergey   (2004-08-03 15:39:00) [16]

Нет
Только свойств из Published
Либо см. COM

---

Sandman25   (2004-08-03 15:39:00) [17]

Только Published

---

Наверх