Форум: "Основная";
Текущий архив: 2004.08.15;
Скачать: [xml.tar.bz2];

Вниз

Список методов у объекта   Найти похожие ветки 

← →
Sectey ©   (2004-08-03 15:38) [0]

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

---

← →
KSergey ©   (2004-08-03 15:39) [1]

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

---

← →
Sandman25 ©   (2004-08-03 15:39) [2]

Только Published

---

← →
Sectey ©   (2004-08-03 15:44) [3]

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

---

← →
Sergey Kaminski ©   (2004-08-03 15:49) [4]

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

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

---

← →
KSergey ©   (2004-08-03 15:53) [5]

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

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

---

← →
Sandman25 ©   (2004-08-03 15:58) [6]

[5] KSergey ©   (03.08.04 15:53)

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

Конечно.

---

← →
Игорь Шевченко ©   (2004-08-03 16:05) [7]

KSergey ©   (03.08.04 15:53) [5]


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


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

---

← →
KSergey ©   (2004-08-03 16:08) [8]

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

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

---

← →
Sandman25 ©   (2004-08-03 16:11) [9]

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

---

← →
Sectey ©   (2004-08-03 16:30) [10]

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

---

← →
Игорь Шевченко ©   (2004-08-03 16:31) [11]

Sandman25 ©   (03.08.04 16:11)

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

---

← →
Sectey ©   (2004-08-03 16:32) [12]

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

---

← →
Игорь Шевченко ©   (2004-08-03 16:33) [13]

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


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.


---

← →
Игорь Шевченко ©   (2004-08-03 16:35) [14]

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

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.


---

← →
Sandman25 ©   (2004-08-03 16:45) [15]

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

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

---

← →
Sectey ©   (2004-08-03 16:54) [16]

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

---

← →
Sectey ©   (2004-08-03 16:54) [17]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.08.15;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.04 c