call published 方法指针的的问题, published 的方法修改父类属性就访问违规， 不知道审什么原因？

Question

//类定义
unit Unit2;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TTest = class(TComponent)
  private
    FXMString: String;
    procedure setXMString(value: String);
    function GetXMLString: String;
  public
    destructor Destroy; override;
    property XMLStrng: String read GetXMLString write setXMString;
  public
  end;  TATest = class(TTest)
  private
    procedure ShowTest;
  published
    procedure test;
  end;implementation{ TTest }
destructor TTest.Destroy;
begin
  inherited;
end;function TTest.GetXMLString: String;
begin
  Result := FXMString;
end;procedure TTest.setXMString(value: String);
begin
  FXMString := value;
end;{ TATest }procedure TATest.test;
begin
  //XMLStrng := 'select * from tablename'; //这句注释去掉就错误， 访问违规, 估计是delphi 对封装的访问规则， 不知道对否。
  ShowMessage('0k');
end;procedure TATest.ShowTest;
begin
  ShowMessage(XMLStrng);
  ShowMessage(ClassName);
end;initialization
  RegisterClass(TATest);
finalization
  UnRegisterClass(TATest);
end.//调用方法
procedure TForm1.Button1Click(Sender: TObject);
var
  p: pointer;
  AComponent: TComponent;
  test: TPersistentClass;
begin
  test := GetClass('TATest');
  if test = nil then Exit;
  AComponent := TComponentClass(test).Create(nil);
  p := AComponent.MethodAddress('test');
  if p = nil then Exit;
  asm
    call p ;
  end;
  AComponent.Free;
end;
//问题就在下面
procedure TATest.test;
begin
  //XMLStrng := 'select * from tablename'; //这句注释去掉就错误， 访问违规, 估计是delphi 对封装的访问规则， 不知道对否。如何解决这个问题？
  ShowMessage('0k');
end;

Answer 1

類設計方式是沒有問題，你的調用方式有問題
  asm 
    call p ; 
  end; 
這樣調用，應該沒有把對象的指針傳進去，test是一個對象方法，你把它當作普通方法了。因而找不到對象中的XMLStrng，造成 access invalid。

Answer 2

你可以這樣調用
TATest(test).Test

Answer 3

procedure TForm1.Button1Click(Sender: TObject);
var
  p: pointer;
  AComponent: TComponent;
  test: TPersistentClass;
begin
  test := GetClass('TATest');
  if test = nil then Exit;
  AComponent := TComponentClass(test).Create(nil);
  p := AComponent.MethodAddress('test');
  if p = nil then Exit;
  asm
    push eax;
    mov  eax, AComponent;
    call p ;
    pop eax;
  end;
  AComponent.Free;
end;
谢谢楼上提醒梦中人啊！ 把对象指针传过去就ok了！ 问题可以解决了。

Answer 4

procedure TForm1.Button1Click(Sender: TObject); 
var 
  p: pointer; 
  AComponent: TComponent; 
  test: TPersistentClass; 
begin 
  test := GetClass('TATest'); 
  if test = nil then Exit; 
  AComponent := TComponentClass(test).Create(nil); 
  p := AComponent.MethodAddress('test'); 
  if p = nil then Exit; 
  asm 
    push eax; //这句可去掉
    mov  eax, AComponent; 
    call p ; 
    pop eax; //这句可去掉
  end; 
  AComponent.Free; 
end; 

Answer 5

呵呵，為什么要用內嵌匯編呢？調用TATest(test).Test編譯後，也應該是一樣的

Answer 6

如果都已经知道了TATest,那就不需要大费周章地去用MethodAddress取函数地址.

Answer 7

正确方法：
type
  TTestProc = procedure of object;
var
  m: TMethod;
begin
  m.Code := MethodAddress('test');
  m.Data := Self;   //为何你访问属性就会出错呢？原因就在这里
  TTestProc(m);
end;

Answer 8

  回复楼上的近因为是不知道啊！ 我的设计是这样；
   
  unit BuClass;interfaceuses
  Windows, Messages, SysUtils, Classes;
type
  TBuClass = class(TComponent)
  private
    FReturnCode: Integer;
    FReturnMsg: String;
    FXMLString: String;
    function GetXMLString: String;
    procedure SetXMLString(values: String);
    function GetReturnCode: Integer;
    procedure SetReturnCode(values: Integer);
    function GetReturnMsg: String;
    procedure SetReturnMsg(values: String);
   protected
    procedure InitReturnValue;
  public
    property ReturnCode: Integer read GetReturnCode write SetReturnCode;
    property ReturnMsg : String  read GetReturnMsg  write SetReturnMsg;
    property XMLString : String  read GetXMLString  write SetXMLString;
  published
    { Published declarations }
  end;implementation
{ TBuClass }
function TBuClass.GetReturnCode: Integer;
begin
  Result := FReturnCode;
end;function TBuClass.GetReturnMsg: String;
begin
  Result := FReturnMsg
end;function TBuClass.GetXMLString: String;
begin
  Result := FXMLString;
end;procedure TBuClass.InitReturnValue;
begin
  FReturnCode := 0;
  FReturnMsg  := '';
end;procedure TBuClass.SetReturnCode(values: Integer);
begin
  FReturnCode := values;
end;procedure TBuClass.SetReturnMsg(values: String);
begin
  FReturnMsg := values;
end;procedure TBuClass.SetXMLString(values: String);
begin
  FXMLString := values;
end;end.
//上面是每个业务对象的父对象， 放在一个baseClass.bpl 包里面而一些业务对象实在另一个包里面比如： sysMgr.bpl 包
通过动态装载sysMgr.bpl ， 然后创建业务对象 所以就有 call 了
但是现在在我的这样方式还有问题， 还是地址错误！ 郁闷

Answer 9

m.Data := Self;   //为何你访问属性就会出错呢？原因就在这里原因：
一个方法包含有允许访问的数据和代码，如果你不关联这个方法的数据（我的理解就是汇编里的data segment），那么它自然就不能访问到对象里的数据。你按我的这种写法，应该就是正确的了，我以前碰到过类似的问题。

Answer 10

正确方法：
type
  TTestProc = procedure of object;
var
  m: TMethod;
begin
  m.Code := MethodAddress('test');
  m.Data := Self;   //为何你访问属性就会出错呢？原因就在这里
  TTestProc(m);
end;
跟下面调用没有什么区别
asm 
  push eax; //这句可去掉
  mov  eax, AComponent; 
  call p ; 
  pop eax; //这句可去掉
end; 

Answer 11

现在是TMethod这种调用方法还有问题，还是怎样呢?

Answer 12

 各个业务对象的方法不可能都相同的！ 但现在就是想使用delphi 提供的rtti 完成那是很好的事情！现在是TMethod这种调用方法还有问题，还是怎样呢? 还是有问题！

Answer 13

还有问题？没理由吧，我以前都是这么写的，我再写段程序验证下好了。我怀疑问题是出在你的BPL上，你谈到动态加载，那么，sysMnl.bpl的requeirs里面有引用baseClass.bpl吗？

Answer 14

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzButton;type
  TForm1 = class(TForm)
    RzButton1: TRzButton;
    procedure RzButton1Click(Sender: TObject);
  private
    { Private declarations }
  published
    procedure Test;
  end;var
  Form1: TForm1;implementation{$R *.dfm}type
  TTestProc = procedure of object;procedure TForm1.RzButton1Click(Sender: TObject);
var
  m: TMethod;
begin
  m.Code := MethodAddress('Test');
  m.Data := Self;
  TTestProc(m);  //正确显示"TForm1"
end;procedure TForm1.Test;
begin
  ShowMessage(Caption);
end;end.这个应该和你的例子原理一样吧，貌似没有任何问题。

Answer 15

 那当然引用baseClass.bpl了！ 要不然怎么继承TBuClass

Answer 16

请对照我发的例子找找原因。我还是认为问题在你的程序上，假如TMethod这种调用还出错的话。请把你的主程序和涉及的几个BPL的依赖关系列一下，最重要的是必须共享rtl，包括主程序，因为你涉及了GetClass。

Answer 17

  问题已经不是这段代码的问题了！ 是我的一个XML解释器出的问题！ 
谢谢各位帮忙。 问题已经解决。