Попытка доступа к методам класса

← →
Юрий_К (2007-01-11 19:28) [0]

http://www.clubdelphi.com/foros/archive/index.php/t-32526.html
Нашёл в сети код (линк дал выше) :
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.
Использовал так:
procedure TForm1.Button1Click(Sender: TObject); var MethodIterator: TPublishedMethodIterator; Cls: TClass; begin re2.Clear; MethodIterator := TPublishedMethodIterator.Create; Cls := Sender.ClassType; try with MethodIterator do begin while Cls <> nil do begin Init(Cls); re2.Lines.Add(Format("%s, %d methods",[TClass(VMT).ClassName, GetMethodCount])); First; while (Current <> nil) do begin re2.Lines.Add(Format(" %s: $%p",[Current^.Name, Current^.Address])); Next; end; Cls := Cls.ClassParent; end; end; finally MethodIterator.Free; end;
Что получил:
"
TButton, 0 methods
TButtonControl, 0 methods
TWinControl, 0 methods
TControl, 0 methods
TComponent, 0 methods
TPersistent, 0 methods
TObject, 0 methods
"
Что же, у всех этих классов кол-во публичных методов равно нулю?
Или что-то тут не так?

← →
vlad-mal © (2007-01-11 20:12) [1]

> http://www.clubdelphi.com/foros/archive/index.php/t-32526.
> htmlНашёл в сети код (линк дал выше) :

Обрати внимание на это:
En el artículo Run-Time Type Information (RTTI) in Delphi (http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm), de Brian Long (http://www.blong.com/), se explica bastante bien cómo puede obtenerse información sobre tipos en tiempo de ejecución. No os perdáis el resto de documentación disponible en la página Web de Brian Long.

← →
Бурундук © (2007-01-11 22:37) [2]

Юрий_К (11.01.07 19:28)
Что же, у всех этих классов кол-во публичных методов равно нулю?

Разумеется, равно нулю.
Публичные методы используются в основном для обработчиков событий,
всяких Form1Create, Button1Click и т.п.

PS код, кстати, мой.

← →
GrayFace © (2007-01-12 02:14) [3]

Точнее, нет published методов. Public тоже переводится как публичный.

← →
Anatoly Podgoretsky © (2007-01-12 02:16) [4]

> GrayFace (12.01.2007 02:14:03) [3]

Зато published так не переводится.

← →
Джо © (2007-01-12 05:44) [5]

> [2] Бурундук © (11.01.07 22:37)
> Юрий_К (11.01.07 19:28)
> Что же, у всех этих классов кол-во публичных методов равно
> нулю?
>
> Разумеется, равно нулю.

TButton = class(TButtonControl) public constructor Create(AOwner: TComponent); override; procedure Click; override; function UseRightToLeftAlignment: Boolean; override; end;Не считая предков, там вообще море.

← →
Бурундук © (2007-01-12 10:05) [6]

Джо © (12.01.07 05:44) [5]
описался, блин. Опубликованных, конечно.

← →
Бурундук © (2007-01-12 10:15) [7]

Вы слушайте, что я имею ввиду, а не то, что я говорю!
(с) Фейнман

← →
Джо © (2007-01-12 10:16) [8]

> Бурундук

Гм. И автор вопрос тоже «описался»? Или «был введен в заблуждение»? Желательно было бы определиться и автору вопроса и автору кода :)

← →
Юрий_К (2007-01-12 11:40) [9]

Бурундук © (11.01.07 22:37) [2]
"Разумеется, равно нулю.
Публичные методы используются в основном для обработчиков событий,
всяких Form1Create, Button1Click и т.п."

Использование кода было в "procedure TForm1.Button1Click(Sender: TObject);".
Почему хотя бы этот Button1Click в таком случае не посчитался? Может он динамический?

VMTDemo (Delphi2) от Рэя Лишнера даёт
"
VMT=0042348C
Destroy=00412D70
FreeInstance=004029B8
NewInstance=00402990
DefaultHandler=00413EF0
InstanceSize=264
ClassParent=TButtonControl (004233D8)
ClassName=TButton
ClassInfo=00423568
DynMethodTable=00423540
Count: 5
Dyn Method 0=00425DB8 (B005)
Dyn Method 1=00425E20 (B006)
Dyn Method 2=00425EA0 (B007)
"
procedure WriteVmtInfo(ClassType: TClass); var Vmt: PVmt; begin Vmt := PVmt(ClassType); Dec(Vmt, 1); FmtLn("VMT=%p", [Vmt]); FmtLn(" Destroy=%p", [Vmt^.Destroy]); FmtLn(" FreeInstance=%p", [Vmt^.FreeInstance]); FmtLn(" NewInstance=%p", [Vmt^.NewInstance]); FmtLn(" DefaultHandler=%p", [Vmt^.DefaultHandler]); FmtLn(" InstanceSize=%d", [Vmt^.InstanceSize]); if Vmt^.ClassParent = nil then WriteLn(" ClassParent=nil") else FmtLn(" ClassParent=%s (%p)", [Vmt^.ClassParent.ClassName, Pointer(Vmt^.ClassParent)]); WriteLn(" ClassName=", GetClassName(Vmt)^); {$ifdef WIN32} FmtLn(" ClassInfo=%p", [Vmt^.TypeInfo]); {$else} FmtLn(" ClassInfo=%x", [Vmt^.TypeInfo]); {$endif} {$ifdef WIN32} FmtLn(" DynMethodTable=%p", [Vmt^.DynMethodTable]); {$else} FmtLn(" DynMethodTable=%x", [Vmt^.DynMethodTable]); {$endif} if Vmt^.DynMethodTable <> VmtNil then WriteDynMethods(Vmt); {$ifdef WIN32} FmtLn(" MethodTable=%p", [Vmt^.MethodTable]); {$else} FmtLn(" MethodTable=%x", [Vmt^.MethodTable]); {$endif} if Vmt^.MethodTable <> VmtNil then WriteMethods(GetMethodTable(Vmt)); {$ifdef WIN32} FmtLn(" FieldTable=%p", [Vmt^.FieldTable]); {$else} FmtLn(" FieldTable=%x", [Vmt^.FieldTable]); {$endif} if Vmt^.FieldTable <> VmtNil then WriteFields(GetFieldTable(Vmt)); {$ifndef VER80} FmtLn(" InitTable=%p", [Vmt^.InitTable]); if Vmt^.InitTable <> nil then WriteInitTable(GetInitTable(Vmt)); FmtLn(" AutoTable=%p", [Vmt^.AutoTable]); if Vmt^.AutoTable <> nil then WriteAutoTable(GetAutoTable(Vmt)); {$endif} end;

← →
Юрий_К (2007-01-12 11:43) [10]

Не совсем полностью скопировал выше:
"
VMT=0042348C
Destroy=00412D70
FreeInstance=004029B8
NewInstance=00402990
DefaultHandler=00413EF0
InstanceSize=264
ClassParent=TButtonControl (004233D8)
ClassName=TButton
ClassInfo=00423568
DynMethodTable=00423540
Count: 5
Dyn Method 0=00425DB8 (B005)
Dyn Method 1=00425E20 (B006)
Dyn Method 2=00425EA0 (B007)
Dyn Method 3=00425DA4 (BD11)
Dyn Method 4=00425CA8 (-11)
MethodTable=00000000
FieldTable=00000000
InitTable=00000000
AutoTable=00000000
"

← →
Бурундук © (2007-01-12 11:50) [11]

2Юрий_К (12.01.07 11:40) [9]

>Использование кода было в
>"procedure TForm1.Button1Click(Sender: TObject);".
>Почему хотя бы этот Button1Click в таком случае не посчитался?
>Может он динамический?

Какая разница, откуда ты вызвал код?
Чтобы увидеть Button1Click, тебе нужно смотреть
опубликованные методы класса TForm1,
а ты смотрел методы класса TButton.

Если хочешь увидеть Button1Click, поменяй
Cls := Sender.ClassType;
на
Cls := Self.ClassType;

← →
Юрий_К (2007-01-12 12:09) [12]

Ваша правда, через Self.ClassType получаем Button1Click.
А как всё же с публичными методами, где их количество смотреть? А также количество свойств класса, которые через "property" даются в объявлении класса?

← →
evvcom © (2007-01-12 12:14) [13]

> [12] Юрий_К (12.01.07 12:09)
> А как всё же с публичными методами, где их количество смотреть?

А зачем? В общем случае никак. Почитай про RTTI.

← →
Бурундук © (2007-01-12 12:23) [14]

2Юрий_К (12.01.07 12:09) [12]
>А как всё же с публичными методами, где их количество смотреть?

Количество public методов можно посчитать в исходном коде :-)
Количество published методов можно посчитать с помощью моего кода.

Как ты переводишь слово "публичный"?

И вообще, какова цель твоих изысканий?

← →
Юрий_К (2007-01-12 12:26) [15]

Что-то в этом роде нашёл по линку (http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm)
procedure TForm1.Button2Click(Sender: TObject); var Count, Loop: Integer; List: TPropList; begin Count := GetPropList(TypeInfo(TForm1), tkAny, @List); re2.Lines.BeginUpdate; for Loop := 0 to Pred(Count) do re2.Lines.Add(List[Loop]^.Name); re2.Lines.EndUpdate; end;
Получили
"
Action
ActiveControl
Align
AlphaBlend
AlphaBlendValue
Anchors
AutoScroll
AutoSize
BiDiMode
BorderIcons
BorderStyle
BorderWidth
Caption
ClientHeight
ClientWidth
Color
Constraints
Ctl3D
Cursor
DefaultMonitor
DockSite
DragKind
DragMode
Enabled
Font
FormStyle
Height
HelpContext
HelpFile
HelpKeyword
HelpType
Hint
HorzScrollBar
Icon
KeyPreview
Left
Menu
Name
ObjectMenuItem
OldCreateOrder
OnActivate
OnCanResize
OnClick
OnClose
OnCloseQuery
OnConstrainedResize
OnContextPopup
OnCreate
OnDblClick
OnDeactivate
OnDestroy
OnDockDrop
OnDockOver
OnDragDrop
OnDragOver
OnEndDock
OnGetSiteInfo
OnHelp
OnHide
OnKeyDown
OnKeyPress
OnKeyUp
OnMouseDown
OnMouseMove
OnMouseUp
OnMouseWheel
OnMouseWheelDown
OnMouseWheelUp
OnPaint
OnResize
OnShortCut
OnShow
OnStartDock
OnUnDock
ParentBiDiMode
ParentFont
PixelsPerInch
PopupMenu
Position
PrintScale
Scaled
ScreenSnap
ShowHint
SnapBuffer
Tag
Top
TransparentColor
TransparentColorValue
UseDockManager
VertScrollBar
Visible
Width
WindowMenu
WindowState
"

← →
Бурундук © (2007-01-12 12:42) [16]

Юрий_К (12.01.07 12:26) [15]
Что ты хочешь в результате получить-то?
Цель какая?

← →
Юрий_К (2007-01-12 13:12) [17]

Цель - узнать, к чему через RTTI можно получать доступ?

← →
Джо-со-смарта (2007-01-12 13:23) [18]

К опубликованным методам классов, скомпилированных с директивой {M+} (и их наследников).

← →
Юрий_К (2007-01-12 13:29) [19]

А например адрес какого-то свойства узнать, чтобы значение этого свойства поменять, разве нельзя?

← →
wal © (2007-01-12 13:38) [20]

> [19] Юрий_К (12.01.07 13:29)
Во первых свойство совсем не обязательно можно менять, во вторых, своисво - это не просто изменение (чтение) значения, а, в общем случае, еще и действие.

← →
Юрий Зотов © (2007-01-12 13:46) [21]

> Юрий_К (12.01.07 13:12) [17]

> к чему через RTTI можно получать доступ?

К полям, свойствам и методам класса, находящимся в его секции protected и при условии, что этот класс откомпилирован с опцией {M+}, либо является потомком класса, откомпилированного с опцией {M+}.

← →
Юрий Зотов © (2007-01-12 13:47) [22]

> protected
published, конечно.

← →
Юрий_К (2007-01-12 20:27) [23]

wal © (12.01.07 13:38) [20]
"своисво - это не просто изменение (чтение) значения, а, в общем случае, еще и действие."

http://delphikingdom.ru/asp/viewitem.asp?catalogid=1296
"Есть такой виндовый контрол - Pagecontrol. В VCL этот контрол реализован компонентом TPageControl, одной из особенностей которого является неуправляемая толщина рамки. Дело в том, что свойство BorderWidth, объявленное в секции protected базового класса TWinControl, не вынесено в классе TPageControl в секцию published.

Раньше меня это не волновало, но в дизайн программы, которую я сейчас разрабатываю, рамка Pagecontrol"a ну никак н вписывается. Возник вопрос, как ее убрать. Есть стандартный метод - написать новый класс - наследник Pagecоntrol"a, и в нем опубликовать свойство BorderWidth. Но это тот случай когда овчинка выделки не стоит. Вспомнился прием одного программиста на С++, который, когда делал проект на Дельфи, модифицировал стандартные библиотеки :(.
Мы пойдем другим путем.

Создаем новый тестовый проект, кидаем на форму разные компоненты, в которых BorderWidth опубликовано (StatusBar, TreeView, etc), и пишем код, измеряющий расстояние между адресом объекта и адресом его свойства BorderWidth. Для всех компонентов он один и тот же - 364 байта. Делаем индуктивный вывод, о том, что у всех наследников TWinControl на 364 байте находится BorderWidth. Проверяем на PageControl"e.
Работает :)"

Как же это у него сработало, то есть действия нужные произвелись?
Наверное при прорисовке они и произвелись. Изменяем свойство и делаем Update или Repaint.

Юрий_К (12.01.07 20:27) [23]
Это делается гораздо проще:
type TStripPageControl = class(TPageControl) end; TStripPageControl(PageControl1).BorderWidth:=5;
Работает, т.к. ко всему, что объявлено в классе есть доступ в пределах модуля.

Еще можно менять Read-Only property, у которых значение берется из поля: TControlState((@SpeedButton1.ControlState)^):=[];

Юрий_К (12.01.07 20:27) [23]
Наверное при прорисовке они и произвелись. Изменяем свойство и делаем Update или Repaint.
Наверное при Resize. Update/Repaint не достаточно.

← →
Юрий_К (2007-01-21 21:51) [25]

Продолжение темы:
Было
"Бурундук © (12.01.07 11:50) [11]
...
Чтобы увидеть Button1Click, тебе нужно смотреть
опубликованные методы класса TForm1,
а ты смотрел методы класса TButton.
Если хочешь увидеть Button1Click, поменяй
Cls := Sender.ClassType;
на
Cls := Self.ClassType;"

Итак, получаем некое событие формы (название, адрес и всё что можем с помощью RTTI). Есть вопрос, как существующую процедуру события подменить другой процедурой с такими же параметрами. К примеру Дельфи позволяет подключать плагины или эксперты. А я хочу скажем подменить событие File->Open так, чтобы и старые действия выполнялись и ещё некоторые мои. Получу метод "FileOpen", но как его заменить на мою "MyFileOpen"? Можете посоветовать?
procedure MyFileOpen(Sender : TObject) begin //... некий код FileOpen(Sender); //... некий код end;

Юрий_К (21.01.07 21:51) [25]

Я занимался внутренним устройством РТТИ во времена Д5
из чисто научного интереса.
В те времена была возможность получить список аргументов
у опубликованного свойства-события, но не было возможности
получить список аргументов у опубликованного метода.
Дальше я этой темой не занимался.
Не так давно я с удивлением узнал, что в Д7 появилась возможность
поместить в РТТИ информацию о параметрах методов.

http://www.delphikingdom.com/asp/answer.asp?IDAnswer=41057

Однако же, исходя из Ваших вопросов
> подменить событие File->Open так, чтобы и
> старые действия выполнялись и ещё некоторые мои
(а этого сделать нельзя, по крайней мере без извращений)

у меня сложилось впечатление, что Вы не очень хорошо
понимаете назначение и возможности данного подхода и,
скажем так, степень осознанности его выбора оставляет
желать лучшего.

На счёт "FileOpen". Предположим, это метод формы.
Назначен же, скорее всего, этот метод будет свойству
MenuItem.OnClick.
Предположим, Вы получили метод TForm1.FileOpen по
имени, и даже получили информацию о его аргументах.
По данной информации нельзя определить, какому свойству
какого объекта этот метод присвоен. Из этой информации
на MenuItem.OnClick никак не выйдешь.
И никак не подменишь, поскольку непонятно, у кого что подменять.

Обсуждаемый подход в принципе, способен
дать ответ, какие опубликованные методы TForm1
формально подходят для свойства MenuItem.OnClick.
Т.е чтобы пользователь мог из комбобокса
выбрать любой обработчик. Например, Paintbox1Paint...
На мой взгляд, это приемлемо только в случае,
если этот пользователь - программист (и в случае чего - сам дурак).

В общем, пока что я абсолютно не понимаю постановку задачи.

← →
Юрий_К (2007-01-22 14:38) [27]

Что имеем на данный момент?
var FileOpenItem: TMenuItem; FileOpen: TNotifyEvent; Method: TMethod; ... TMethod(FileOpen) := GetMethodProp(FileOpenItem, GetPropInfo(FileOpenItem, "OnClick")); TNotifyEvent(Method) := MiFileOpen; // тут компилер показывает ошибку SetMethodProp(FileOpenItem, GetPropInfo(FileOpenItem, "OnClick"), Method);
Получаем ошибку:
[Error] ...: Incompatible types: "method pointer and regular procedure"
Что-то не так в общем.

> TNotifyEvent(Method) := MiFileOpen; // тут компилер показывает
> ошибку

MiFileOpen должен быть методом класса, а не регулярной процедурой.

О чем, собственно, и пишет компилятор.

← →
Юрий_К (2007-01-22 15:00) [30]

Нашёл такой код: ...\Delphi7\Source\Clx\qControls.pas
Что-то в этом есть, как выход не просто процедуру пишем, а к событию своей формы цепляем.
procedure TWidgetControl.ResetEvents; var I, Count: Integer; PropInfo: PPropInfo; TempList: PPropList; OrigMethod: TMethod; NilMethod: TMethod; begin Count := GetPropList(PTypeInfo(ClassInfo), TempList); if Count > 0 then begin try NilMethod.Code := nil; for I := 0 to Count - 1 do begin PropInfo := TempList^[I]; if PropInfo^.PropType^.Kind = tkMethod then begin OrigMethod := GetMethodProp(Self, PropInfo); if Assigned(OrigMethod.Code) then begin SetMethodProp(Self, PropInfo, NilMethod); SetMethodProp(Self, PropInfo, OrigMethod); end; end; end; finally FreeMem(TempList); end; end; end;

> [30] Юрий_К (22.01.07 15:00)
> Что-то в этом есть, как выход не просто процедуру пишем,
> а к событию своей формы цепляем.

Это — не «как выход». Это и есть правильное решение.

Попытка доступа к методам класса Найти похожие ветки