unit1.pas

这是一个演示程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    LV1: TListView;
    Label2: TLabel;
    CB1: TComboBox;
    Panel3: TPanel;
    Label1: TLabel;
    LV2: TListView;
    CB2: TComboBox;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    InfoMemo: TMemo;
    Panel7: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure CB2Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  IMyInterface1 = interface
  ['{2D752AEC-3CDA-4905-B660-EB73C2A44900}']
    procedure DoSomeThing1;
  end;
  IMyInterface2 = interface
  ['{6837D93B-7AED-4A64-9F9E-260A6B2DFFF6}']
    procedure DoSomeThing2;
  end;
  TMyInterfacedObject = class(TInterfacedObject, IMyInterface1, IMyInterface2)
  public
    Str : string;
    procedure DoSomeThing1;
    procedure DoSomeThing2;
  end;

  TViewer = class
  private
    FOutPut : TListView;
    FStrings : TStrings;
    procedure ViewInterfacedObject(AObj : TObject);
    procedure ViewMyInterfacedObject(AObj : TObject);
  public
    procedure ViewBy(ACB : TComboBox);
    procedure Add(AStr : string);
    procedure ViewClassInfo;
    property Strings : TStrings read FStrings write FStrings;
  end;
var
  Form1: TForm1;
  Obj1, Obj2 : TInterfacedObject;
  MyObj1, MyObj2 : TMyInterfacedObject;
  Intf1, Intf2 : IInterface;
  MyIntf1 : IMyInterface1;
  MyIntf2 : IMyInterface2;
  Viewer : TViewer;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Obj1 := TInterfacedObject.Create;
  Intf1 := Obj1;
  Obj2 := TInterfacedObject.Create;
  Intf2 := Obj2;
  MyObj1 := TMyInterfacedObject.Create;
  MyObj1.Str := 'MyObj1';
  MyIntf1 := MyObj1;
  MyObj2 := TMyInterfacedObject.Create;
  MyObj2.Str := 'MyObj2';
  MyIntf2 := MyObj2;
  Viewer := TViewer.Create;
  viewer.Strings := TStringList.Create;
  Form1.InfoMemo.Lines.LoadFromFile('ReadMe.Txt');
  viewer.ViewClassInfo;
end;

{ TMyInterfacedObject }
procedure ExchangeStrings;
var Temp : TStrings;
begin
  try
    Temp := TStringList.Create;
    Temp.Assign(Form1.InfoMemo.Lines);
    Form1.InfoMemo.lines.Assign(Viewer.Strings);
    Viewer.Strings.Assign(Temp);
  finally // wrap up
    Temp.Free;
  end;    // try/finally
end;
procedure TMyInterfacedObject.DoSomeThing1;
begin
end;

procedure TMyInterfacedObject.DoSomeThing2;
begin
end;

{ TViewer }

procedure TViewer.Add(AStr: string);
begin
  FStrings.Add(AStr)
end;

procedure TViewer.ViewBy(ACB: TComboBox);
begin
  case ACB.Tag of    //
    1: FOutput := Form1.LV1;
    2: FOutput := Form1.LV2;
  end;    // case
  FOutPut.Clear;
  case ACB.ItemIndex of    //
    0: self.ViewInterfacedObject(Obj1);
    1: self.ViewInterfacedObject(Obj2);
    2: self.ViewMyInterfacedObject(MyObj1);
    3: self.ViewMyInterfacedObject(MyObj2);
  end;    // case
end;

procedure TViewer.ViewClassInfo;
var
  AStr : string;
  AIntfEntry : PInterfaceEntry;
  AClass : TClass;
begin
  FStrings.Clear;
  AClass := TInterfacedObject;

  Add('TInterfacedObject实现了IInterface一个接口');
  AStr := 'TInterfacedObject之IInterface接口入口表地址';
  AIntfEntry := AClass.GetInterfaceEntry(IInterface);
  AStr :=AStr + InttoHex(Integer(Pointer(AIntfEntry)),4);
  Add(AStr);
  Add('Interface接口方法表指针在对象内存空间的偏移量为：'+ IntToHex(AIntfEntry^.IOffset,2));
  Add('IInterface接口的GUID字符串: ' + GuidToString(AIntfEntry^.IID));
  Add('IInterface VTable指针地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable)),4));
  ADD('IInterface VTable表格地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable^)),4));

  Add('===============================================');
  AClass := TMyInterfacedObject;
  Add('TMyInterfacedObject实现了IInterface, IMyInterface1, IMyInterface2 3个接口');
  AStr := 'TMyInterfacedObject之IInterface接口入口表地址';
  AIntfEntry := AClass.GetInterfaceEntry(IInterface);
  AStr :=AStr + InttoHex(Integer(Pointer(AIntfEntry)),4);
  Add(AStr);
  Add('Interface接口方法表指针在对象内存空间的偏移量为：'+ IntToHex(AIntfEntry^.IOffset,2));
  Add('IInterface接口的GUID字符串: ' + GuidToString(AIntfEntry^.IID));
  Add('IInterface VTable指针地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable)),4));
  ADD('IInterface VTable表格地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable^)),4));
  Add('--------------------------------------');
  AStr := 'TMyInterfacedObject之IMyInterface1接口入口表地址';
  AIntfEntry := AClass.GetInterfaceEntry(IMyInterface1);
  AStr :=AStr + InttoHex(Integer(Pointer(AIntfEntry)),4);
  Add(AStr);
  Add('IMynterface1接口方法表指针在对象内存空间的偏移量为：'+ IntToHex(AIntfEntry^.IOffset,2));
  Add('IMynterface1接口的GUID字符串: ' + GuidToString(AIntfEntry^.IID));
  Add('IMynterface1 VTable指针地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable)),4));
  ADD('IMynterface1 VTable表格地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable^)),4));
  Add('---------------------------------------');
  AStr := 'TMyInterfacedObject之IMyInterface2接口入口表地址';
  AIntfEntry := AClass.GetInterfaceEntry(IMyInterface2);
  AStr :=AStr + InttoHex(Integer(Pointer(AIntfEntry)),4);
  Add(AStr);
  Add('IMynterface2接口方法表指针在对象内存空间的偏移量为：'+ IntToHex(AIntfEntry^.IOffset,2));
  Add('IMynterface2接口的GUID字符串: ' + GuidToString(AIntfEntry^.IID));
  Add('IMynterface2 VTable指针地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable)),4));
  ADD('IMynterface2 VTable表格地址为：' + IntToHex(Integer(Pointer(AIntfEntry^.VTable^)),4));

  Add('++++++++++++++++++++++++++++++++++++');
  Add('Intf1接口指针状态');
  Add('指针地址: '+ IntToHex(Integer(Intf1),4));
  Add('指向地址：'+ IntTohex(Integer(Pointer(Intf1)^),4));

  Add('-----------------------------------');
  Add('Intf2接口指针状态');
  Add('指针地址: '+ IntToHex(Integer(Intf2),4));
  Add('指向地址：'+ IntTohex(Integer(Pointer(Intf2)^),4));

  Add('-----------------------------------');
  Add('MyIntf1接口指针状态');
  Add('指针地址: '+ IntToHex(Integer(MyIntf1),4));
  Add('指向地址：'+ IntTohex(Integer(Pointer(MyIntf1)^),4));

  Add('-----------------------------------');
  Add('MyIntf2接口指针状态');
  Add('指针地址: '+ IntToHex(Integer(MyIntf2),4));
  Add('指向地址：'+ IntTohex(Integer(Pointer(MyIntf2)^),4));
end;

procedure TViewer.ViewInterfacedObject(AObj: TObject);
var
  PInstance : PPointer;
begin
  if AObj = nil then Raise Exception.Create('Object = nil');
  PInstance := Pointer(AObj);
  with FOutPut.Items.Add do
  begin
    caption := '0';
    Subitems.Add('0');
    SubItems.Add(IntToStr(AObj.InstanceSize));
    SubItems.Add('对象占有内存字节数')
  end;    // with
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('00');
    SubItems.Add(IntToHex(Integer(PInstance^),4));
    SubItems.Add('EAX, 对象首地址, 指向类VMT的指针')
  end;    // with
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('04');
    SubItems.Add(IntToStr(Integer(PInstance^)));
    SubItems.Add('EAX+$04, 对象引用计数')
  end;    // with
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('08');
    SubItems.Add(IntToHex(Integer(PInstance^),4));
    SubItems.Add('EAX+$08, IInterface接口表格指针')
  end;    // with
end;

procedure TViewer.ViewMyInterfacedObject(AObj: TObject);
var
  PInstance : PPointer;
begin
  if AObj = nil then Raise Exception.Create('Object = nil');
  PInstance := Pointer(AObj);
  with FOutPut.Items.Add do
  begin
    caption := '0';
    Subitems.Add('0');
    SubItems.Add(IntToStr(AObj.InstanceSize));
    SubItems.Add('对象占有内存字节数')
  end;    // with
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('00');
    SubItems.Add(IntToHex(Integer(PInstance^),4));
    SubItems.Add('EAX, 对象首地址, 指向类VMT的指针')
  end;    // with
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('04');
    SubItems.Add(IntToStr(Integer(PInstance^)));
    SubItems.Add('EAX+$04, 对象引用计数')
  end;    // with
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('08');
    SubItems.Add(IntToHex(Integer(PInstance^),4));
    SubItems.Add('EAX+$08, IInterface接口表格指针')
  end;    // with
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('0C');
    SubItems.Add(String(PInstance^));
    SubItems.Add('EAX+$0C, Object.Str值');
  end;
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('10');
    SubItems.Add(IntToHex(Integer(PInstance^),4));
    SubItems.Add('EAX+$10, IMyInterface2接口表格指针')
  end;    // with
  Inc(PInstance);
  with FOutPut.Items.Add do
  begin
    caption := IntToHex(Integer(PInstance), 4);
    Subitems.Add('14');
    SubItems.Add(IntToHex(Integer(PInstance^),4));
    SubItems.Add('EAX+$14, IMyInterface1接口表格指针')
  end;    // with
end;

procedure TForm1.CB2Change(Sender: TObject);
begin
  viewer.ViewBy(sender as TComboBox);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExchangeStrings;
end;

end.