有哪位高人知道怎么求 自定义函数字符串表达式 的值？ 如‘mysum(7,5) + mysum(6,3)’

[sois2000]

我想在我程序中实现以下功能。

用户输入字符串表达式如‘mysum(7,5) + mysum(6,3)’
其中mysum是我已经定义的一个求和函数，我如何才能求得整个字符串表达式的值呢？

似乎要用到编译知识，哪位高手能给个源码最好了。

[sois2000]

[Quote=引用 15 楼 keiy 的回复:]
引用 12 楼 sois2000 的回复:
试了以下，估计MicroSoft Script Control不行，处理不了表达式里有delphi的数据类型的情况。


如果都是基本类型,MicroSoft Script Control可以处理,如double,你也可转成string传给MSC
但如果是复杂类型,你要将它传给MSC,就比较繁了(但不是不能处理)
如果楼主一定要一个符合PASCAL的角本,那可以好好研究下RemObjects Pascal Script,如果用过inno setup
就可以知道它的强大功能了
[/Quote]


看来只能寄希望于RemObjects Pascal Script了，我去找个来看看。

[budded]

function TCalculator.Calc(const Expression: String): Double;
begin
  CalcExpression := Expression;
  Result := Calc;
end;

function TCalculator.CalcBool: Boolean;
var
  FR: Double;
begin
  FR := Calc;
  Result := not IsZero(FR, CONST_EPSILON);
end;

function TCalculator.CalcBool(const Expression: String): Boolean;
var
  FR: Double;
begin
  FR := Calc(Expression);
  Result := not IsZero(FR, CONST_EPSILON);
end;

procedure TCalculator.ClearParam;
begin
  SetLength(FParamArray, 0);
end;

constructor TCalculator.Create;
begin
  ClearParam;
  AddParam('INF', Infinity);
  AddParam('PI', PI);
end;

destructor TCalculator.Destroy;
begin
  ClearParam;

  inherited;
end;

procedure TCalculator.DoCalc;

  function CalcSingle(const AOperator: TOperator): Double;         // 单目操作符
  var
    iLoop: Integer;
    Base: Double;
  begin
    Result := 0.00;
    Base := PopNumber;

    case AOperator of  // case
      oNot:
        Result := IfThen(IsZero(Base, CONST_EPSILON), 1, 0);         //

      oABS:
        Result := Abs(Base);
      oSqr:
        Result := Sqr(Base);
      oSqt:
        Result := Sqrt(Abs(Base));
      oLn:
        Result := Ln(Base);
      oFact:
        begin
          Result := Round(Base);
          for iLoop := Round(Base) - 1 downto 1 do
          try
            Result := Result * iLoop;
          except
            Result := Infinity;
          end;
        end;
      oSin:
        Result := Sin(Base);
      oCos:
        Result := Cos(Base);
      oTan:
        Result := Tan(Base);
      oCot:
        Result := Cot(Base);
    end;       // end case
  end;
  function CalcDouble(const AOperator: TOperator): Double;         // 双目操作符
  var
    Base, Exponent: Double;
  begin
    Result := 0.00;

    Exponent := PopNumber;
    Base := PopNumber;

    case AOperator of    // case
      oPower, oPow:
        Result := Power(Base, Exponent);
      oMulitiple:
        Result := Base * Exponent;
      oDevide:
        if SameValue(Exponent, 0) then
          Result := Infinity
        else Result := Base / Exponent;
      oMod:
        if SameValue(Round(Exponent), 0) then
          Result := Infinity
        else Result := Round(Base) mod Round(Exponent);
      oAdd:
        Result := Base + Exponent;
      oSub:
        Result := Base - Exponent;
      oLog:
        Result := LogN(Base, Exponent);
      oLdexp:
        Result := Ldexp(Base, Round(Exponent));

      oGreater:
        Result := IfThen(Base > Exponent, 1, 0);
      oLess:
        Result := IfThen(Base < Exponent, 1, 0);
      oNoGreater:
        Result := IfThen(Base <= Exponent, 1, 0);
      oNoLess:
        Result := IfThen(Base >= Exponent, 1, 0);
      oEqual:
        Result := IfThen((Base = Exponent) or SameValue(Base, Exponent, CONST_EPSILON), 1, 0);
      oUnEqual:
        Result := IfThen((Base = Exponent) or SameValue(Base, Exponent, CONST_EPSILON), 0, 1);

      oAnd:
        Result := IfThen((Base > CONST_EPSILON) and (Exponent > CONST_EPSILON), 1, 0);
      oOr:
        Result := IfThen((Base > CONST_EPSILON) or (Exponent > CONST_EPSILON), 1, 0);
    end;
  end;

var
  Operator: TOperator;
  FCalcResult: Double;
begin
  Operator := PopOperator;
  if not (Operator in [oBracketL, oBracketR]) then
  begin
    case Operators[Operator].OperandCount of    // case
      1: FCalcResult := CalcSingle(Operator);
      2: FCalcResult := CalcDouble(Operator);
    else FCalcResult := 0.00;       // case else
    end;         // end case

    PushNumber(FCalcResult);           // 计算结果入栈
  end;
end;

function TCalculator.GetOperatorType(const AChar: Char): TOperator;
var
  iLoop: TOperator;
begin
  Result := TOperator(-1);
  for iLoop := Low(TOperator) to High(TOperator) do    // Iterate
    if AChar = Operators[iLoop].Operator then
    begin
      Result := iLoop;
      Break;
    end;
end;

procedure TCalculator.ParseChar(const AChar: Char);

  function GetCalcCharState(const AChar: Char): TCalcState;
  begin
    Result := csParam;
    if AChar in SetOfNumber then
      Result := csNumber
    else if GetOperatorType(AChar) in [Low(TOperator)..High(TOperator)] then
           Result := csOperator;
  end;
var
  CalcCharState: TCalcState;
  TempDouble: Double;
begin
  CalcCharState := GetCalcCharState(AChar);
  try
    case CalcCharState of  // case
      csNumber, csParam:
        FCalcString := FCalcString + AChar;
      csOperator:
        begin
          case FCalcState of    // case
            csNumber:
              if TryStrToFloat(FCalcString, TempDouble) then
                PushNumber(TempDouble)
              else raise Exception.Create('Invalid Number Input!');
            csParam:
              if not PushParam(FCalcString) then
                raise Exception.Create('Invalid Parameter Input!');
          end;         // end case

          FCalcString := '';
          if not PushOperator(GetOperatorType(AChar)) then
            raise Exception.Create('Invalid Operator Input!');
        end;
    end;       // end case
  finally
    FCalcState := CalcCharState;  // 保存当前字符类型
  end;
end;

function TCalculator.PeekOperator: TOperator;
begin
  Result := TOperator(FStackOperators.Peek);
end;

function TCalculator.PopNumber: Double;
begin
  Result := Double(FStackNumbers.Pop);
end;

function TCalculator.PopOperator: TOperator;
begin
  Result := TOperator(FStackOperators.Pop);
end;

function TCalculator.PushNumber(const ANumber: Double): Boolean;
begin
  Result := FStackNumbers.Push(ANumber);
end;

function TCalculator.PushOperator(const AOperator: TOperator): Boolean;

  function OperatorCanPush: Boolean;
  var
    oOperator: TOperator;
  begin
    Result := True;
    if FStackOperators.Count > 0 then
    begin
      oOperator := PeekOperator;                            // 得到栈顶操作符
      Result := (oOperator = oBracketL) or
        (Operators[AOperator].Rights < Operators[oOperator].Rights);
    end;
  end;

begin
  Result := True;
  if AOperator <> oComma then
  begin
    { 判断入栈操作符与栈顶操作符优先级 }
    while not OperatorCanPush do
      DoCalc;

    if AOperator <> oBracketR then
      Result := FStackOperators.Push(AOperator)
    else begin
           PopOperator;
           Result := True;
         end;
  end;
end;

[budded]

还有个尾巴

function TCalculator.PushParam(const AParam: String): Boolean;
var
  iLoop: Integer;
begin
  Result := False;
  for iLoop := Low(FParamArray) to High(FParamArray) do    // Iterate
  begin
    // SameText is not Case Sensitive
    if SameText(FParamArray[iLoop].Param, AParam) then
    begin
      Result := PushNumber(FParamArray[iLoop].Value);
      Break;
    end;
  end;    // end for
end;

procedure TCalculator.SetCalcExpression(const Value: String);

  function StringReplaceEx(const S, OldPattern, NewPattern: string;
    Flags: TReplaceFlags): string;
  var
    SearchStr, Patt, NewStr: string;
    Offset: Integer;
  begin
    if rfIgnoreCase in Flags then
    begin
      SearchStr := UpperCase(S);
      Patt := UpperCase(OldPattern);
    end else
    begin
      SearchStr := S;
      Patt := OldPattern;
    end;
    NewStr := S;
    Result := '';
    while SearchStr <> '' do
    begin
      Offset := Pos(Patt, SearchStr);
      if Offset = 0 then
      begin
        Result := Result + NewStr;
        Break;
      end;
      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
      NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
      if not (rfReplaceAll in Flags) then
      begin
        Result := Result + NewStr;
        Break;
      end;
      SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
    end;
  end;

var
  iLoop: TOperator;
  PseudoCode: String;
  Operator: String;
  RFlag: TReplaceFlags;
begin
  FCalcExpression := StringReplaceEx(Value, ' ', '', [rfReplaceAll]);

  // 替换伪代码
  RFlag := [rfReplaceAll, rfIgnoreCase];
  for iLoop := Low(TOperator) to High(TOperator) do
  begin
    PseudoCode := Trim(Operators[iLoop].Pseudocode);
    if Length(PseudoCode) <> 0 then
    begin
      Operator := Operators[iLoop].Operator;
      FCalcExpression := StringReplaceEx(FCalcExpression, Pseudocode, Operator, RFlag);
    end;
  end;  
end;

end.

[sois2000]

TO budded
这么工整的代码啊，我一定得好好看看。谢谢了。

[lihuasoft]

{首先向楼上各位无私奉献的朋友学习了

然后我也写了一段, 只是提供一个思路, 通用性极不强, 楼主可以无视而过}

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

    procedure Test(Str: string);

  published

    function MyFunc1(A, B: integer): integer;
    function MyFunc2(A, B: integer): integer;

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.MyFunc1(A, B: integer): integer;
begin
  Result := A + B;
end;

function TForm1.MyFunc2(A, B: integer): integer;
begin
  Result := A * B;
end;

procedure TForm1.Test(Str: string);
var
  I, J: integer;
  FuncName: string;
  Var1, Var2: integer;
  SS: TStringList;
  pFunc: Pointer;
  Rst: integer;
begin
  Str := StringReplace(Str, #32, '', [rfReplaceAll]);
  FuncName := Copy(Str, 1, Pos('(', Str)-1);
  SS := TStringList.Create;
  I := Pos('(', Str);
  J := Pos(')', Str);
  SS.Text := StringReplace(Copy(Str, I+1, J-I-1), ',', #10, [rfReplaceAll]);
  try
    Var1 := StrtoInt(SS[0]);
  except
    Var1 := PInteger(Self.FieldAddress(SS[0]))^;
  end;
  try
    Var2 := StrtoInt(SS[1]);
  except
    Var2 := PInteger(Self.FieldAddress(SS[1]))^;
  end;
  pFunc := Self.MethodAddress(FuncName);
  asm
    mov eax, Self
    mov edx, Var1
    mov ecx, Var2
    call [pFunc]
    mov Rst, eax
  end;
  Showmessage(InttoStr(Rst));
  SS.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Test('MyFunc1(55,44)');
  Test('MyFunc2(3,5)');
end;

end.

[lihuasoft]

PS：

上面我的想法，还未弄完。比如，尽管加了判断Var是常数或类成员变量的检测，但尚未弄。

暂时不想弄了。 ^_^

[不得闲]

楼主可以去看FastReport的代码,里面有这个解释方面的

[sois2000]

TO lihuasoft
呵呵，是啊，忘了你说的这个第二条了。的确是编译后的寻址问题。

[zwjchina]

RemObject Pascal Script.

[zwjchina]

Lua

[sois2000]

我正在看RemObject Pascal Script.
有进展了会告诉大家。

[lihuasoft]

将23楼代码重新改进了一下，发贴在：

http://topic.csdn.net/u/20080923/19/daae97fa-1fbc-475a-a998-ada94ee23e82.html

因这种思路明显不适用于扩展，所以新发贴。只供楼主参考。

[sois2000]

[Quote=引用 24 楼 lihuasoft 的回复:]
PS：

上面我的想法，还未弄完。比如，尽管加了判断Var是常数或类成员变量的检测，但尚未弄。

暂时不想弄了。 ^_^
[/Quote]


代码理解起来不如文字清晰，能否用文字阐述以下思路？里面还有汇编，我基本不懂这个啊。

[lihuasoft]

[Quote=引用 25 楼 sois2000 的回复:]
代码理解起来不如文字清晰，能否用文字阐述以下思路？里面还有汇编，我基本不懂这个啊。
[/Quote]

那段汇编以及它前面一句 的作用是：寻到Func地址，然后将参数传入寄存器，并调用这个Func，返回值放入Rst。
如果有多个参数（不固定），可以通过计算，多余参数压栈处理----这个倒不是难关。

现在问题有一个最大的难关是：前面的实现方法（包括我的），貌似都不能实现变量的处理。这是最大的难关。因为Delphi程序编译后，普通变量名字已不复存在，通过名字又何处去寻？即使象Func那样，可以利用RTTI，但普通变量做不到，至少需要成员变量是类类型的，或者接口类型的----但你要的是普通变量。

[lihuasoft]

续楼上：

如果沿着我的思路发展，有一种解决难关的办法：Form.Create时，把所有全局变量的名字和内存地址记录下来，比如记录到一个TStringList。然后，在解释字符串时，如果函数参数不为数字，就去这里面找“变量”。关于指针，可以在字串中以[X]的形式表示。

[sois2000]

TO lihuasoft
不太明白你的意思。处理这个问题不涉及到编译后的问题吧？
有变量的话也是在编译前就确定好的了，怎么涉及到编译后按变量名寻址呢？

[lihuasoft]

[Quote=引用 28 楼 sois2000 的回复:]
TO lihuasoft
不太明白你的意思。处理这个问题不涉及到编译后的问题吧？
有变量的话也是在编译前就确定好的了，怎么涉及到编译后按变量名寻址呢？
[/Quote]

1、你的程序如果用Delphi写，总是要编译后才能运行

2、你的需求是：要在编译后运行过程中找源程序代码中的“变量”并让它参与运算

3、Delphi程序编译后，在Pascal源代码中声明的变量名字（如var X:integer中的X），在可执行程序中已经不存在了，编译器直接把它们处理为地址。

4、也正是因为如此，在无数层楼之前，我就建议你全部采用解释型的编程语言。解释型语言有真正意义上的宏替换可供你使用。宏替换

[lihuasoft]

楼主如果连29楼第2条的概念都不清楚，那么，我们在这个贴子解决问题的难度会成倍增加。也就是说，一些代码楼主尚无能力去看懂并理解它，而只是拿到代码测试一下看能不能用----却不能真正地变成自己的代码。

[wyxcode]

[Quote=引用 8 楼 sois2000 的回复:]
TO wyxcode
我没太明白2楼的意思，你明白吗？
你的思路和hys_427相似，可以通过字符串比较判断是否是函数名，然后调用相应函数求值。不过这种方法似乎不够科学，也不知道能不能处理所有情况。
[/Quote]

2楼的意思大体如下：

通过定位字符串来取得函数的参数

左括号和逗号之间，是第一个参数；
逗号和右括号之间，是第二个参数；

2楼通过一系列步骤确定了左括号，逗号，右括号的位置，然后通过某函数就取得了两个参数的值，然后执行运算，最后返回结果。

[sois2000]

我试了试RemObject Pascal Script. 感觉这是个功能比较全面的工具。
可以实现变量的传递，记录类型的支持，可惜不支持指针。

使用RemObject Pascal Script，字符串表达式不用自己分析，所以代码写起来也比较容易。

我准备采用这种方式了。

积极讨论的我都想给分，可惜分数不多，大家多担待吧。