Delphi实现通过字符串执行Published带参方法

lihuasoft 2008-09-23 07:06:25

问题来源：http://topic.csdn.net/u/20080922/17/622ca10c-9f9c-4f06-a158-ccc8d8455a6e.html

目的：
通过这种形式执行MyFunc函数：TransLate('MyFunc(3,4,5,6)');

因原贴题目较大，讨论方向多元化，所以新开贴供原贴楼主参考。



{

 Delphi实现通过字符串执行Published带参方法

（参数量不固定、参数可以是全局变量）

 作者：LihusSoft

 日期：2008-9-23

 注： 1、本例只是演示一种思路，因此全部采用Integer形参、返回值

      2、三脚猫水准的汇编，看贴的别笑

}



unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  public

    Vs: TStringList; {“变量”列表}

    V1: integer;   {测试用的变量1}

    procedure VsCreate; {用于创建“变量”列表}

    function Translate(Str: string): Variant; {这是主要的一个解释函数}



  published



    function MyFunc1(A, B, C, D, E: integer): integer;{这是测试用的函数}

    function MyFunc2(A, B: integer): integer;      {这也是}



  end;



var

  Form1: TForm1;

  V2: integer; {测试用的变量2}



implementation



{$R *.dfm}



var

  V3: integer; {测试用的变量3}

  V4: PInteger; {测试用的变量4，是一个指针变量}



function TForm1.MyFunc1(A, B, C, D, E: integer): integer;

begin

  Result := A + B*C - D div E;

end;



function TForm1.MyFunc2(A, B: integer): integer;

begin

  Result := A * B;

end;



{----------------------------------------------------}



function TForm1.Translate(Str: string): Variant;

var

  I: integer;

  FuncName: string;

  Vars: array of integer;

  sVars: TStringList;

  pFunc: Pointer;

  Rst: integer;

begin

  Str := StringReplace(Str, #32, '', [rfReplaceAll]);

  FuncName := Copy(Str, 1, Pos('(', Str)-1);

  pFunc := Self.MethodAddress(FuncName);

  sVars := TStringList.Create;

  I := Pos('(', Str);

  sVars.Text := StringReplace(Copy(Str, I+1, Pos(')', Str)-I-1), ',', #10, [rfReplaceAll]);

  SetLength(Vars, 0);

  for I := 0 to sVars.Count-1 do begin

    SetLength(Vars, Length(Vars)+1);

    case sVars[I][1] of

      '1'..'9',

      '0'       : Vars[High(Vars)] := StrtoInt(sVars[I]);

      'a'..'z',

      'A'..'Z',

      '_'       : Vars[High(Vars)] := PInteger(StrtoInt('$'+Vs.Values[sVars[I]]))^;

      '['       : Vars[High(Vars)] := PInteger(Pointer(StrtoInt('$'+Vs.Values[Copy(sVars[I],2,Length(sVars[I])-2)]))^)^;

    end;

  end;

  asm

    mov edi, Vars

    mov edx, [edi]-4

    sub edx, 2

    cmp edx, 0

    jz @DONE

    mov edx, 2

  @AGAIN:

    mov eax, [edi]+edx*4

    push eax

    inc edx

    mov eax, [edi]-4

    cmp edx, eax

    jz @DONE

    jmp @AGAIN

  @Done:

    mov ecx, [edi]+4

    mov edx, [edi]

    mov eax, Self

    call pFunc

    {此处暂存疑：是否需要修复栈顶？}

    mov Rst, eax

  end;

  Result := Rst;

  sVars.Free;

end;



procedure TForm1.Button1Click(Sender: TObject); {测试}

begin

  Showmessage(InttoStr(Translate('MyFunc1(5,6,11,22,2)'))); {5+(6*11)-(22/2)=60}

  Showmessage(InttoStr(Translate('MyFunc1(2,[V4],V1,V2,2)')));{自己验算}

  V4 := @V3;

  Showmessage(InttoStr(Translate('MyFunc2(9,[V4])')));{9*8=72}

  V3 := 9;

  Showmessage(InttoStr(Translate('MyFunc2(9,[V4])')));{9*9=81}

end;



{----------------------------------------------------}



procedure TForm1.FormCreate(Sender: TObject);

begin

  V1 := 6;

  V2 := 10;

  V3 := 8;

  V4 := @V2;

  VsCreate;

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  if Assigned(Vs) then FreeAndNil(Vs);

end;



procedure TForm1.VsCreate;

begin

  if not Assigned(Vs) then Vs := TStringList.Create;

  Vs.Clear;

  Vs.Add(Format('V1=%p', [@V1]));

  Vs.Add(Format('V2=%p', [@V2]));

  Vs.Add(Format('V3=%p', [@V3]));

  Vs.Add(Format('V4=%p', [@V4]));

end;



{----------------------------------------------------}



end.