fmmain.~pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

unit fmMain;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit4: TEdit;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Memo1: TMemo;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
    function HashOf(const Key: string): Cardinal;
  public
    { Public declarations }
    function ShowMethodAddress(aObj : TDerived; const sData : String) : Pointer;
    procedure ShowFieldAddress(aObj : TDerived; const sData : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.HashOf(const Key: string): Cardinal;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(Key) do
    Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
      Ord(Key[I]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  aObj : TBase;
begin
  aObj := TBase.Create;
  Edit1.Text := aObj.toString + aObj.hashCode;
  Edit2.Text := aObj.getBothID;
  FreeAndNil(aObj);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  aObj : TBase;
begin
  aObj := TDerived.Create('TDerived at ' + DateTimeToStr(Now));
  Edit1.Text := aObj.toString + aObj.hashCode;
  Edit2.Text := aObj.getBothID;
//  Edit3.Text := aObj.getBothID(0);
//  Edit4.Text := aObj.getBothID(' - ');
  FreeAndNil(aObj);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  aObj : TDerived;
begin
  aObj := TDerived.Create('TDerived at ' + DateTimeToStr(Now));
  Edit1.Text := aObj.toString + aObj.hashCode;
  Edit2.Text := aObj.getBothID;
  Edit3.Text := aObj.getBothID(0);
  Edit4.Text := aObj.getBothID(' - ');
  FreeAndNil(aObj);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  aObj : TDerived;
  sData : String;
begin
  sData := 'TDerived at ' + DateTimeToStr(Now);
  aObj := TDerived.Create(sData, HashOf(sData));
  Edit1.Text := aObj.toString + aObj.hashCode;
  Edit2.Text := aObj.getBothID;
  Edit3.Text := aObj.getBothID(0);
  Edit4.Text := aObj.getBothID(' - ');
  FreeAndNil(aObj);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  aObj : TDerived;
  sData : String;
begin
  sData := 'TDerived at ' + DateTimeToStr(Now);
  aObj := TDerived.Create(sData, HashOf(sData));
  Edit1.Text := aObj.DisappearRoutine1;
  Edit2.Text := aObj.DisappearRoutine1('Test');
  FreeAndNil(aObj);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  aObj : TBase;
begin
  aObj := TBase.Create;
  Edit1.Text := aObj.DisappearRoutine1;
//  Edit2.Text := aObj.DisappearRoutine1('Test');
  FreeAndNil(aObj);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  aObj : TDerived;
  sData : String;
  aPtr : Pointer;
begin
  sData := 'TDerived at ' + DateTimeToStr(Now);
  aObj := TDerived.Create(sData, HashOf(sData));

  ShowMethodAddress(aObj, 'getBothID');

  ShowMethodAddress(aObj, 'toString');
  ShowMethodAddress(aObj, 'MyMethod1');
  aPtr := ShowMethodAddress(aObj, 'MyMethod2');
  sData := MethodName(aPtr);
  sData := Format('%x : %s', [Integer(aPtr), sData]);
  Memo1.Lines.Add(sData);

  aPtr := Pointer(@TDerived.MyMethod2);
  sData := MethodName(aPtr);
  sData := Format('%x : %s', [Integer(aPtr), sData]);
  Memo1.Lines.Add(sData);

  aPtr := Pointer(@TDerived.PureMethod);
  sData := MethodName(aPtr);
  sData := Format('%x : %s', [Integer(aPtr), sData]);
  Memo1.Lines.Add(sData);
  FreeAndNil(aObj);
end;

function TForm1.ShowMethodAddress(aObj: TDerived; const sData: String) : Pointer;
var
  aPtr : Pointer;
  sResult : String;
begin
  try
    aPtr := aObj.MethodAddress(sData);
    sResult := Format('%s : %x', [sData + '位于：', Integer(aPtr)]);
    Memo1.Lines.Add(sResult);
  except
    on e : Exception do
    begin
      sResult := Format('%s : %s', [sData, e.Message]);
      Memo1.Lines.Add(sResult);
    end;
  end;
  Result := aPtr;
end;

procedure TForm1.ShowFieldAddress(aObj: TDerived; const sData: String);
var
  aPtr : Pointer;
  sResult : String;
begin
  try
    aPtr := aObj.FieldAddress(sData);
    sResult := Format('%s : %x', [sData + '位于：', Integer(aPtr)]);
    Memo1.Lines.Add(sResult);
  except
    on e : Exception do
    begin
      sResult := Format('%s : %s', [sData, e.Message]);
      Memo1.Lines.Add(sResult);
    end;
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  sData : String;
  aPtr : Pointer;
begin
  aPtr := Pointer(@Self.OnClick);
  sData := MethodName(aPtr);
  sData := Format('%x : %s', [Integer(aPtr), sData]);
  Memo1.Lines.Add(sData);
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  Self.Caption := 'Clicked';
end;

end.