pascal学习小记（六）---VMT

今天看了《VCL》一章，感受很多，一般都学习JAVA的，对于面向对象用另外一个思维去解释的时候就显得有点不可以去适应了。

看了一下下午也只看了一个叫VMT的东西，虚拟方法表。明白了一个virtual与dynamic方法的区别。

相对来说，virtual占用的内存会很大比较多，每个子类都会把父类的的方法都列出来；对于dynamic就不会这样做的了，它只会把子类覆盖的放在VMT表中，其它的它会往上面找父类的方法。这个为VCL节省了很多内存。效率相对于virtual是相对慢了一点，可是节省了50%的空间，才拖延了3%的时间，很好的时间换空间的例子。

 内存的逻辑结构为：

 

 

 

实验代码：

unit fmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ComCtrls, DB, DBTables, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    RadioButton1: TRadioButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Database1: TDatabase;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    lbVMTs: TListBox;
    lbVMTContents: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    aClass : TClass;
    sClassName : String;

    procedure ShowVMTResult(const Msg: string);
    procedure ShowVMTEntry(const iDelta: Integer; pVMT: Pointer);
    procedure ShowVMTContent(aVMT: TClass);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  aClass := Self.Button1.ClassType;
  sClassName := 'TButton';
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  aClass := Self.CheckBox1.ClassType;
  sClassName := 'TCheckBox';
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  aClass := Self.RadioButton1.ClassType;
  sClassName := 'TRadioButton';
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  aClass := Self.ListBox1.ClassType;
  sClassName := 'TListBox';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  aClass := Self.ClassType;
  sClassName := 'TForm1';
end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
  aClass := Self.Memo1.ClassType;
  sClassName := 'TMemo';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  aClass := Self.Database1.ClassType;
  sClassName := 'TDatabase';
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  ShowVMTContent(aClass);
end;

const
  VMTOFFSET = 12;
  VMTDELTA = 4;

procedure TForm1.ShowVMTContent(aVMT: TClass);
var
  pVMT : Pointer;
  idx : Integer;
begin
  ShowVMTResult(sClassName + ' VMT表格地址 : ' + IntToStr(Integer(aVMT)) );
  pVMT := Pointer(aVMT);
  idx := VMTOFFSET;
  while (idx > vmtSelfPtr) do
  begin
    ShowVMTEntry(idx, pVMT);
    Dec(idx, VMTDELTA);
  end;    // while
end;

procedure TForm1.ShowVMTEntry(const iDelta: Integer; pVMT: Pointer);
var
  pResult : Pointer;
  Msg : String;

  procedure DoProcess(const sName : String);
  begin
    if (Assigned(pResult)) then
    begin
      Msg := Format('%s : %x', [sName, Integer(pResult)]);
      ShowVMTResult(Msg);
    end;
  end;

begin
  pResult := Pointer(Integer(pVMT) + iDelta);
  case iDelta of    //
    vmtCreateObject : DoProcess('vmtCreateObject');
    vmtRelease : DoProcess('vmtRelease');
    vmtAddRef : DoProcess('vmtAddRef');
    vmtQueryInterface : DoProcess('vmtQueryInterface');
    vmtDestroy : DoProcess('vmtDestroy');
    vmtFreeInstance : DoProcess('vmtFreeInstance');
    vmtNewInstance : DoProcess('vmtNewInstance');
    vmtDefaultHandler : DoProcess('vmtDefaultHandler');
    vmtDispatch : DoProcess('vmtDispatch');
    vmtBeforeDestruction : DoProcess('vmtBeforeDestruction');
    vmtAfterConstruction : DoProcess('vmtAfterConstruction');
    vmtSafeCallException : DoProcess('vmtSafeCallException');
    vmtParent : DoProcess('vmtParent');
    vmtInstanceSize : DoProcess('vmtInstanceSize');
    vmtClassName : DoProcess('vmtClassName');
    vmtDynamicTable : DoProcess('vmtDynamicTable');
    vmtMethodTable : DoProcess('vmtMethodTable');
    vmtFieldTable : DoProcess('vmtFieldTable');
    vmtTypeInfo : DoProcess('vmtTypeInfo');
    vmtInitTable : DoProcess('vmtInitTable');
    vmtAutoTable : DoProcess('vmtAutoTable');
    vmtIntfTable : DoProcess('vmtIntfTable');
    vmtSelfPtr : DoProcess('vmtSelfPtr');
  end;    // case
end;

procedure TForm1.ShowVMTResult(const Msg: string);
begin
  Self.lbVMTs.Items.Add(Msg);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  aPnl : TPanel;
  aForm : TForm1;
begin
  aClass := aPnl.ClassType;
  sClassName := 'TPanel';
  ShowVMTContent(aClass);

  aPnl := TPanel.Create(Self);
  aClass := aPnl.ClassType;
  sClassName := 'TPanel';
  ShowVMTContent(aClass);
  FreeAndNil(aPnl);


end;

procedure TForm1.Button5Click(Sender: TObject);
var
  Msg : String;
  pVMT : Pointer;
begin
  Msg := Format('%s : %x', ['Self', Integer(Pointer(Self))]);
  ShowVMTResult(Msg);
  pVMT := Pointer(Integer(Pointer(Self)^) + vmtSelfPtr);
  Msg := Format('%s : %x', ['vmtSelfPtr', Integer(Pointer(pVMT))]);
  ShowVMTResult(Msg);
  pVMT := Pointer(Pointer(Integer(Pointer(Self)^) + vmtSelfPtr)^);
  Msg := Format('%s : %x', ['vmtSelfPtr', Integer(Pointer(pVMT))]);
  ShowVMTResult(Msg);
end;

end.

 

显示实验为：