为.Net CF写的表达式解析类

暑假的时候想写一个PLOT程序，于是想到要用.Net写一个表达式解析类。下面就是由古董VB5代码转过来的代码。很长，很痛苦。而且效率及其低下，基本不能满足PLOT程序的要求。（就是画一个二次函数都要1.5秒） 但是我发现它有了新的用途，于是用它做了一个公式计算器（稍后发布）。下面是代码。

Public Class CEvalClass CEval
    Private Const STATE_NONE As Short = 0
    Private Const STATE_OPERAND As Short = 1
    Private Const STATE_OPERATOR As Short = 2
    Private Const STATE_UNARYOP As Short = 3
    Private Const UNARY_NEG As String = "(-)"
    Private m_sErrMsg As String
    Public m_SymbolTable As New CSymbolTable
    Friend Function InfixToPostfix()Function InfixToPostfix(ByRef sExpression As String, ByRef sBuffer As String) As Short
        Dim i As Short, iTemp As Short '声明循环用变量
        Dim ch, sTemp As String   '声明临时变量
        Dim nCurrState, nParenCount As Short  '声明状态变量
        Dim bDecPoint As Boolean
        Dim stkTokens As New Stack '定义新栈
        sExpression = UCase(sExpression)
        sReplace(sExpression)
        nCurrState = STATE_NONE
        nParenCount = 0
        i = 1
        Do Until i > Len(sExpression) '开始循环
            ch = Mid(sExpression, i, 1) '取得表达式中下一个字符
            Select Case ch  '对字符类型做出响应
                Case "("
                    If nCurrState = STATE_OPERAND Then '不能接操作数
                        m_sErrMsg = "Operator expected"
                        GoTo EvalError
                    End If
                    If nCurrState = STATE_UNARYOP Then '允许接一元操作符
                        nCurrState = STATE_OPERATOR
                    End If
                    stkTokens.Push(ch) '压栈
                    nParenCount += 1 '栈中括号的计数+1
                Case ")"
                    If nCurrState <> STATE_OPERAND Then  '只能跟操作数
                        m_sErrMsg = "Operand expected"
                        GoTo EvalError
                    End If
                    If nParenCount = 0 Then
                        m_sErrMsg = "Closing parenthesis without matching open parenthesis"
                        GoTo EvalError
                    End If
                    sTemp = stkTokens.Pop  '弹出所有元素直到遇到(
                    Do Until sTemp = "("
                        sBuffer = sBuffer & sTemp & " " '加入到后缀表达式中
                        sTemp = stkTokens.Pop
                    Loop
                    nParenCount -= 1 '栈中括号的计数-1
                Case "+", "-", "*", "/", "^"
                    If nCurrState = STATE_OPERAND Then '如果上一字符是操作符
                        Do While stkTokens.Count > 0 '弹出不小于ch优先级的操作符
                            If GetPrecedence(stkTokens.Peek) < GetPrecedence(ch) Then
                                Exit Do
                            End If
                            sBuffer = sBuffer & stkTokens.Pop & " "
                        Loop
                        stkTokens.Push(ch)
                        nCurrState = STATE_OPERATOR '当前状态=操作符
                    ElseIf nCurrState = STATE_UNARYOP Then '不允许接一元操作符
                        m_sErrMsg = "Operand expected"
                        GoTo EvalError
                    Else
                        If ch = "-" Then '如果是负号 将"(-)"压栈
                            stkTokens.Push(UNARY_NEG)
                            nCurrState = STATE_UNARYOP
                        ElseIf ch = "+" Then '如果是正号 直接忽略
                            nCurrState = STATE_UNARYOP
                        Else
                            m_sErrMsg = "Operand expected"
                            GoTo EvalError
                        End If
                    End If
                Case "0" To "9", "."
                    If nCurrState = STATE_OPERAND Then  '不能跟其它操作数
                        m_sErrMsg = "Operator expected"
                        GoTo EvalError
                    End If
                    sTemp = ""
                    bDecPoint = False
                    Do While InStr("0123456789.", ch)
                        If ch = "." Then
                            If bDecPoint Then '不允许出现多个小数点
                                m_sErrMsg = "Operand contains multiple decimal points"
                                GoTo EvalError
                            Else
                                bDecPoint = True
                            End If
                        End If
                        sTemp = sTemp & ch
                        i = i + 1
                        If i > Len(sExpression) Then Exit Do
                        ch = Mid(sExpression, i, 1)
                    Loop
                    i = i - 1 '还原计数器
                    If sTemp = "." Then '如果只含有.返回错误
                        m_sErrMsg = "Invalid operand"
                        GoTo EvalError
                    End If
                    sBuffer = sBuffer & sTemp & " "
                    nCurrState = STATE_OPERAND
                Case Is <= " " '忽略空格,tab等.
                Case "a" To "z"
                    stkTokens.Push(ch)
                    nCurrState = STATE_UNARYOP
                Case Else
                    If nCurrState = STATE_OPERAND Then
                        m_sErrMsg = "Operator expected"
                        GoTo EvalError
                    End If
                    If IsSymbolCharFirst(ch) Then
                        sTemp = ch
                        i = i + 1
                        If i <= Len(sExpression) Then
                            ch = Mid(sExpression, i, 1)
                            Do While IsSymbolChar(ch)
                                sTemp = sTemp & ch
                                i = i + 1
                                If i > Len(sExpression) Then Exit Do
                                ch = Mid(sExpression, i, 1)
                            Loop
                        End If
                    Else
                        m_sErrMsg = "Unexpected character encountered"
                        GoTo EvalError
                    End If
                    If m_SymbolTable.IsSymbolDefined(sTemp) Then '判断是否变量定义过
                        sBuffer = sBuffer & sTemp & " "
                        nCurrState = STATE_OPERAND
                        i = i - 1
                    Else
                        m_sErrMsg = "Undefined symbol : '" & sTemp & "'"
                        i = i - Len(sTemp)
                        GoTo EvalError
                    End If
            End Select
            i = i + 1
        Loop

        If nCurrState = STATE_OPERATOR Or nCurrState = STATE_UNARYOP Then
            m_sErrMsg = "Operand expected"
            GoTo EvalError
        End If
        If nParenCount > 0 Then
            m_sErrMsg = "Closing parenthesis expected" '检查括号
            GoTo EvalError
        End If

        Do Until stkTokens.Count = 0     '弹出所有元素
            sBuffer = sBuffer & stkTokens.Pop & " "
        Loop
        InfixToPostfix = 0
        Exit Function
EvalError:
        InfixToPostfix = i
        Exit Function
    End Function
    Private Function GetPrecedence()Function GetPrecedence(ByRef ch As String) As Short
        Select Case ch
            Case "+", "-"
                GetPrecedence = 1
            Case "*", "/"
                GetPrecedence = 2
            Case "^"
                GetPrecedence = 3
            Case UNARY_NEG
                GetPrecedence = 10
            Case Else
                GetPrecedence = 0
        End Select
    End Function
    Friend Function DoEvaluate()Function DoEvaluate(ByRef sExpression As String) As Double
        Dim i As Short, j As Short
        Dim stkTokens As New Stack '建立新栈
        Dim sTemp As String '声明临时变量
        Dim Op1 As Object, Op2 As Object '声明两个弹出数据
        i = 1  '初始化i
        j = InStr(sExpression, " ")  '由于表达式中空格来分隔元素 所以找出空格在表达式中的位置
        Do Until j = 0
            'Extract token from expression
            sTemp = Mid(sExpression, i, j - i)  '从表达式中取出元素
            If IsNumeric(sTemp) Then   '如果元素是数字,那么压栈
                stkTokens.Push(CDbl(sTemp))
            Else        '如果是其他情况(操作符)
                Select Case sTemp
                    Case "+"   '当加号时 弹出两次 相加 压栈
                        stkTokens.Push(stkTokens.Pop + stkTokens.Pop)
                    Case "-"  '当是减号时 弹出压栈  以下同理 不再赘述
                        Op1 = stkTokens.Pop
                        Op2 = stkTokens.Pop
                        stkTokens.Push(Op2 - Op1)
                    Case "*"
                        stkTokens.Push(stkTokens.Pop * stkTokens.Pop)
                    Case "/"
                        Op1 = stkTokens.Pop
                        Op2 = stkTokens.Pop
                        stkTokens.Push(Op2 / Op1)
                    Case "^"
                        Op1 = stkTokens.Pop
                        Op2 = stkTokens.Pop
                        stkTokens.Push(Op2 ^ Op1)
                    Case UNARY_NEG '当是负号
                        stkTokens.Push(-CDbl(stkTokens.Pop))
                    Case "a"
                        stkTokens.Push(Math.Abs(CDbl(stkTokens.Pop)))
                    Case "b"
                        stkTokens.Push(Math.Acos(CDbl(stkTokens.Pop)))
                    Case "c"
                        stkTokens.Push(Math.Asin(CDbl(stkTokens.Pop)))
                    Case "d"
                        stkTokens.Push(Math.Atan(CDbl(stkTokens.Pop)))
                    Case Else
                        stkTokens.Push(CDbl(m_SymbolTable.Value(sTemp)))
                End Select
            End If

            i = j + 1 '计数器加一
            j = InStr(i, sExpression, " ")
        Loop
        '弹出结果
        If stkTokens.Count > 0 Then '如果表达式不为空,弹出结果
            DoEvaluate = stkTokens.Pop
        Else
            DoEvaluate = 0        '表达式为空,返回0
        End If
    End Function
    Private Function IsSymbolCharFirst()Function IsSymbolCharFirst(ByRef sChar As String) As Boolean
        Dim c As String
        c = Left(sChar, 1)
        If (c >= "A" And c <= "Z") Or InStr("_", c) Then
            IsSymbolCharFirst = True
        Else
            IsSymbolCharFirst = False
        End If
    End Function
    Private Function IsSymbolChar()Function IsSymbolChar(ByRef sChar As String) As Boolean
        Dim c As String
        c = Left(sChar, 1)
        If (c >= "A" And c <= "Z") Or InStr("0123456789_", c) Then
            IsSymbolChar = True
        Else
            IsSymbolChar = False
        End If
    End Function
    Private Function sReplace()Function sReplace(ByRef sExpression As String)
        sExpression = sExpression.Replace("ABS", "a")
        sExpression = sExpression.Replace("ACOS", "b")
        sExpression = sExpression.Replace("ASIN", "c")
        sExpression = sExpression.Replace("ATAN", "d")
        sExpression = sExpression.Replace("COS", "e")
        sExpression = sExpression.Replace("COSH", "f")
        sExpression = sExpression.Replace("FRAC", "g")
        sExpression = sExpression.Replace("INT", "h")
        sExpression = sExpression.Replace("LOG", "i")
        sExpression = sExpression.Replace("LN", "j")
        sExpression = sExpression.Replace("SIN", "k")
        sExpression = sExpression.Replace("SINH", "l")
        sExpression = sExpression.Replace("SQRT", "m")
        sExpression = sExpression.Replace("TAN", "n")
        sExpression = sExpression.Replace("TANH", "o")
    End Function
End Class

Public Class CSymbolTableClass CSymbolTable
    Private m_Symbols As New Collection
    Public Sub Add()Sub Add(ByRef sName As String, ByRef nValue As Object)
        If IsSymbolDefined(sName) = False Then
            If IsNumeric(nValue) Then
                m_Symbols.Add(nValue, sName)
            Else
                Err.Raise(vbObjectError + 1020, , "Invalid symbol value")
            End If
        Else
            Err.Raise(vbObjectError + 1021, , "Symbol already defined")
        End If
    End Sub
    Public Sub Delete()Sub Delete(ByRef sName As String)
        If IsSymbolDefined(sName) Then
            m_Symbols.Remove(sName)
        End If
    End Sub
    Public Sub Clear()Sub Clear()
        Dim Count As Integer = m_Symbols.Count()
        Dim I As Integer
        For I = 1 To Count
            m_Symbols.Remove(I)
        Next I
    End Sub
    Public Function IsSymbolDefined()Function IsSymbolDefined(ByRef sName As String) As Boolean
        Dim nValue As Object
        On Error Resume Next
        nValue = m_Symbols.Item(sName)
        If Err.Number Then
            IsSymbolDefined = False
        Else
            IsSymbolDefined = True
        End If
    End Function

    Public Property Value()Property Value(ByVal sName As String) As Object
        Get
            If IsSymbolDefined(sName) = True Then
                Value = m_Symbols.Item(sName)
            Else
                Err.Raise(vbObjectError + 1022, , "Symbol not defined")
            End If
        End Get
        Set(ByVal Value As Object)
            If IsSymbolDefined(sName) = True Then
                If IsNumeric(Value) Then
                    Delete(sName)
                    Add(sName, Value)
                Else
                    Err.Raise("Invalid symbol value")
                End If
            Else
                Err.Raise("Symbol not defined")
            End If
        End Set
    End Property


    Public ReadOnly Property Count()Property Count() As Short
        Get
            Count = m_Symbols.Count()
        End Get
    End Property
End Class