救命呀，一个关于自定公式解析的问题，救救我呀，

Question

现在我有一个自定义函数分别需要传递六个参数：
function GetAccountData(科目、部门、取数、年、月、日):double;
用户在我的公式编辑器里面书写公式：（可以加减乘除有括号之类的，）
GetAccountData(<科目:101>,<部门:03>,<取数:期初余额>,<年:2004>,<月:4>,<日:6>)+(GetAccountData(<科目:409>,<取数:期初余额>,<年:2004>,<月:2>,<日:4>,<部门:05>)+1245)
如果GetAccountData(<科目:101>,<部门:03>,<取数:期初余额>,<年:2004>,<月:4>,<日:6>)书写正确是一写可以取到一个double的数
需要给用户提示在哪里错了，我的公式编辑器是用的richedit

Answer 1

给你一段我大学时写的，解释数学表达式并计算出结果的单元。
 我没有按照正规的扫描分析思路写。
而是自己扫描建了一个数据链表。再分析得出结果。 
那时候写的代码很杂乱。献丑献丑。 
unit jisanqi;
interface
uses SysUtils;
type
     lbty=^node;
     node=record
           ch:char;
           re:extended;
           front:lbty;
           next:lbty;
           end;
     newerror=class(exception) //用于阶乘，如果输入参数不为整数产生异常
                end;
     tjisanqi=class
         private
         head:lbty;
         errorelstr:string;
         procedure makelb(str:string);
         procedure dolb;
         function writescore(var isnumber:boolean):string;
         public
         function jisan(var str:string):boolean;
         end;
implementation
const  youxiaowei=40; //数字的有效位, 数字的总长为 youxiaowei+.+youxiaowei (即 2*youxiaowei+1)
       compconst:string[78]='ABS#AARCTAN#BCOS#CEXP#DFRAC#EINT#FLN#GSIN#HSQR#ISQRT#JROUND#KTRUNC#LMOD#MDIV#N';
function xtod(s:string):string;
    function chartod(ch:char):extended;
    begin
        ch:=upcase(ch);
        if ch in ['0'..'9'] then
        begin
            result:=ord(ch)-ord('0');
            exit;
        end;
        if ch in ['A'..'F'] then
        begin
            result:=ord(ch)-ord('A')+10;
            exit;
        end;
        result:=0;
    end;
var i:integer;
    point,n:integer;
    temp:extended;
begin
    temp:=0;
    n:=10;
    if s[length(s)] in ['H','h'] then
        n:=16
    else
        if s[length(s)] in ['Q','q'] then
            n:=8
        else
        if s[length(s)] in ['B','b'] then
            n:=2;
    s[length(s)]:='.';
    point:=pos('.',s);
    for i:=1 to length(s) do
        temp:=temp+chartod(s[i])*exp((point-i-1*ord((point-i)>0))*ln(n));
    result:=floattostr(temp);
end;
function todstr(s:string):string;  //把特殊进制转化为十进制
var i,j,p,first:integer;
    havepoint:boolean;
    temp:string;
begin
    for i:=1 to length(s) do
        s[i]:=upcase(s[i]);
    p:=1;
    j:=1;
    while j<=length(s) do
    begin
        if (s[j]='H') then
            p:=j
        else
        begin
            inc(j);
            continue;
        end;
        havepoint:=false;
        first:=p;
        for i:=p-1 downto 1 do
        begin
            if s[i]='.' then
                if havepoint=false then
                begin
                    first:=i;
                    havepoint:=true;
                end
                else  break
             else
                 if s[i] in ['0'..'9','A'..'F'] then
                     first:=i
                 else
                     break;
        end;
        if first<>p then
        begin
            temp:=copy(s,first,p-first+1);
            delete(s,first,p-first+1);
            insert(xtod(temp),s,first);
            j:=1;
        end
        else inc(j);
    end;
//*****************************************

Answer 2

p:=1;
    j:=1;
    while j<=length(s) do
    begin
        if (s[j]='Q') then
            p:=j
        else
        begin
            inc(j);
            continue;
        end;
        havepoint:=false;
        first:=p;
        for i:=p-1 downto 1 do
        begin
            if s[i]='.' then
                if havepoint=false then
                begin
                    first:=i;
                    havepoint:=true;
                end
                else  break
             else
                 if s[i] in ['0'..'7'] then
                     first:=i
                 else
                     break;
        end;
        if first<>p then
        begin
            temp:=copy(s,first,p-first+1);
            delete(s,first,p-first+1);
            insert(xtod(temp),s,first);
            j:=1;
        end
        else inc(j);
    end;
//*******************************************

Answer 3

p:=1;
    j:=1;
    while j<=length(s) do
    begin
        if (s[j]='B') then
            p:=j
        else
        begin
            inc(j);
            continue;
        end;
        havepoint:=false;
        first:=p;
        for i:=p-1 downto 1 do
        begin
            if s[i]='.' then
                if havepoint=false then
                begin
                    first:=i;
                    havepoint:=true;
                end
                else  break
             else
                 if s[i] in ['0'..'1'] then
                     first:=i
                 else
                     break;
        end;
        if first<>p then
        begin
            temp:=copy(s,first,p-first+1);
            delete(s,first,p-first+1);
            insert(xtod(temp),s,first);
            j:=1;
        end
        else inc(j);
    end;
    result:=s;
end;
function kaifang(x,y:extended):extended;
var yisodd:boolean;
begin
   if (trunc(y)=y)and odd(trunc(y)) then
      yisodd:=true
   else
      yisodd:=false;
   result:=exp(ln(abs(x))/y);
   if (x<0)and yisodd then
   result:=-result;
end;
function chengfang(x,y:extended):extended;
var retemp:extended;
    i:integer;
begin
   if trunc(y)=y then
   begin
       retemp:=1;
       for i:=1 to trunc(y) do
       begin
           retemp:=retemp*x;
       end;
       result:=retemp;
   end
   else
   result:=exp(ln(x)*y);
end;
function jiechen(n:extended):extended;
var temp:extended;
begin
    if trunc(n)<>n then
        raise newerror.create('nointeger');
    temp:=1;
    while n>0 do
    begin
        temp:=temp*n;
        n:=n-1;
    end;
    result:=temp;
end;
      procedure tjisanqi.makelb(str:string);
      var p,q:lbty;
          i:integer;
      begin
          //************
          while pos(' ',str)<>0 do
          begin
              delete(str,pos(' ',str),1);
          end;
          str:=todstr(str);
          errorelstr:='';
          new(p);
          p^.ch:='(';
          p^.front:=nil;
          head:=p;
          q:=p;
          for i:=1 to length(str) do
          begin
              str[i]:=upcase(str[i]);
              if not (str[i] in ['A'..'Z','0'..'9','*','/','+','-','(',')','.','^','~','!']) then
              begin
                  errorelstr:='有非法字符';
                  q^.next:=nil;
                  exit;
              end;
              new(p);
              p^.ch:=str[i];
              q^.next:=p;
              p^.front:=q;
              q:=P;
          end;
          new(p);
          p^.ch:=')';
          p^.next:=nil;
          q^.next:=p;
          p^.front:=q;
      end;
      procedure tjisanqi.dolb;
      label 1;
      var smp1,smp2,sfp,firstnumch,firstch,
          liftp,rightp,smp21,chp,addE:lbty; //addE用来做科学记数法的E的输入的扫描。
          numtemp:string;
          compstr,complbstr:packed array[1..6] of char;
          retemp:extended;
          code,m,n:integer;
          ifhavedrop,iffu,isEaddfu,isEaddzen:boolean; //issEaddfu用来表示E后是否有‘-’号;
      begin
          smp1:=head;
          repeat
              if smp1^.ch in ['(',')'] then
                  smp1:=smp1^.next
              else
              begin
                  iffu:=false;
                  if (smp1.ch in ['+','-'])
                      and not (smp1^.front^.ch in ['@',')'])
                      and (smp1.next^.ch in ['0'..'9']) then
                  begin
                      if smp1^.ch='-' then
                          iffu:=true;
                      sfp:=smp1;
                      smp1:=smp1^.next;
                      sfp^.front^.next:=sfp^.next;
                      sfp^.next^.front:=sfp^.front;
                      dispose(sfp);
                  end;
                  if smp1^.ch in ['0'..'9','.'] then
                  begin
                      firstnumch:=smp1;
                      numtemp:='00000000000000000000000000000000000000000000000000000000000000000000000000000000';