Delphi 2009 的反射單元(ObjAuto):

獨孤求財 2012-03-30

展開全文

Delphi 2009 的反射單元(ObjAuto):

ObjAuto 單元應該算是對 TypInfo 單元的功能擴展吧? 它提供了 5 個方法:
GetMethods、GetMethodInfo、CreateMethodPointer、ReleaseMethodPointer、ObjectInvoke
通過 GetMethods、GetMethodInfo 可以獲取類公用成員的詳細信息.

通過 TypInfo 只能獲取 published 區(qū)中成員的信息(例子);
通過 ObjAuto 也能獲取 public 區(qū)的成員信息.

本例效果圖:

本例有兩個單元, 輔助單元(Unit2)里存放了 3 個用于測試的類:

unit Unit2;

interface

type
//TClass1 沒有指定額外的編譯指令, ObjAuto 只能獲取其 published 區(qū)的方法
  TClass1 = class
    function Fun1: string;
  private
    function Fun1Private: string;
  protected
    function Fun1Protected: string;
  public
    function Fun1Public: string;    
  published
    function Fun1Published: string;
  end;

//TClass2 指定了 {$M+}, ObjAuto 能獲取其 published 區(qū)和默認區(qū)域的方法.
//一般情況下, 默認區(qū)域的成員相當于在 public 區(qū);
//指定了 {$M+} 以后, 默認區(qū)域的成員相當于在 published 區(qū).
//因為 TPersistent(這是很多類的祖先) 已經(jīng)指定了 {$M+}, 所以大多類的都是 {$M+} 打開的.
{$M+}
  TClass2 = class
    function Fun2: string; {默認區(qū)域}
  private
    function Fun2Private: string;
  protected
    function Fun2Protected: string;
  public
    function Fun2Public: string;    
  published
    function Fun2Published: string;
  end;
{$M-}

//編譯指令 Methodinfo 是 Delphi 2009 新增的, 只有它打開了, ObjAuto 才可以獲取 public 區(qū)的信息.
//這樣, ObjAuto 可以獲取 TClass3 的 public、published 和默認區(qū)域的信息.
{$M+}
{$METHODINFO ON}
  TClass3 = class
    function Fun3: string;
  private
    function Fun3Private: string;
  protected
    function Fun3Protected: string;
  public
    function Fun3Public: string;    
  published
    function Fun3Published: string;
  end;
{$METHODINFO OFF}
{$M-}

implementation

{ TClass1 -------------------------------------------------}

function TClass1.Fun1: string;
begin
  Result := 'Fun1';
end;

function TClass1.Fun1Private: string;
begin
  Result := 'Fun1Private';
end;

function TClass1.Fun1Protected: string;
begin
  Result := 'Fun1Protected';
end;

function TClass1.Fun1Public: string;
begin
  Result := 'Fun1Public';
end;

function TClass1.Fun1Published: string;
begin
  Result := 'Fun1Published';
end;


{ TClass2 -------------------------------------------------}

function TClass2.Fun2: string;
begin
  Result := 'Fun2';
end;

function TClass2.Fun2Private: string;
begin
  Result := 'Fun2Private';
end;

function TClass2.Fun2Protected: string;
begin
  Result := 'Fun2Protected';
end;

function TClass2.Fun2Public: string;
begin
  Result := 'Fun2Public';
end;

function TClass2.Fun2Published: string;
begin
  Result := 'Fun2Published';
end;


{ TClass3 -------------------------------------------------}

function TClass3.Fun3: string;
begin
  Result := 'Fun3';
end;

function TClass3.Fun3Private: string;
begin
  Result := 'Fun3Private';
end;

function TClass3.Fun3Protected: string;
begin
  Result := 'Fun3Protected';
end;

function TClass3.Fun3Public: string;
begin
  Result := 'Fun3Public';
end;

function TClass3.Fun3Published: string;
begin
  Result := 'Fun3Published';
end;

end.

主單元(Unit1):

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ObjAuto, Unit2;

{獲取 Unit2.TClass1 的信息}
procedure TForm1.Button1Click(Sender: TObject);
var
  MiArr: TMethodInfoArray;
  Mi: PMethodInfoHeader;
  obj: TClass1;
begin
  obj := TClass1.Create;
  MiArr := GetMethods(obj.ClassType);

  ListBox1.Clear;
  for Mi in MiArr do 
    ListBox1.Items.Add(string(Mi.Name));

  obj.Free;
end;

{獲取 Unit2.TClass2 的信息}
procedure TForm1.Button2Click(Sender: TObject);
var
  MiArr: TMethodInfoArray;
  Mi: PMethodInfoHeader;
  obj: TClass2;
begin
  obj := TClass2.Create;
  MiArr := GetMethods(obj.ClassType);

  ListBox1.Clear;
  for Mi in MiArr do
    ListBox1.Items.Add(string(Mi.Name));

  obj.Free;
end;

{獲取 Unit2.TClass3 的信息}
procedure TForm1.Button3Click(Sender: TObject);
var
  MiArr: TMethodInfoArray;
  Mi: PMethodInfoHeader;
  obj: TClass3;
begin
  obj := TClass3.Create;
  MiArr := GetMethods(obj.ClassType);

  ListBox1.Clear;
  for Mi in MiArr do 
    ListBox1.Items.Add(string(Mi.Name));

  obj.Free;
end;

end.

窗體文件:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 114
  ClientWidth = 211
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 127
    Top = 14
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 121
    Height = 114
    Align = alLeft
    ItemHeight = 13
    TabOrder = 1
  end
  object Button2: TButton
    Left = 127
    Top = 45
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 127
    Top = 76
    Width = 75
    Height = 25
    Caption = 'Button3'
    TabOrder = 3
    OnClick = Button3Click
  end
end