N年前写汇编编译程序，涉及到表达式求值，缺点就是表达式必须用（）括起来
Option Explicit
Dim Decom(1 To 256) As String
Dim theI As Long
'[]==========[]
'[]pop
'[]在stack中弹出字符串，stack栈深度固定为4
'[]==========[]
Private Function Pop(ByRef Stack() As String) As String
Dim i As Long
For i = 4 To 1 Step -1
If Stack(i) <> "" Then
Pop = Stack(i)
Stack(i) = ""
Exit For
End If
Next i
End Function
'[]==========[]
'[]look
'[]察看stack中栈顶字符串，stack栈深度固定为4
'[]==========[]
Private Function Look(ByRef Stack() As String) As String
Dim i As Long
For i = 4 To 1 Step -1
If Stack(i) <> "" Then
Look = Stack(i)
Exit For
End If
Next i
End Function
'[]==========[]
'[]push
'[]向stack中压入字符串，stack栈深度固定为4
'[]==========[]
Private Sub Push(ByRef Stack() As String, ByVal strs As String)
Dim i As Long
For i = 1 To 4
If Stack(i) = "" Then
Stack(i) = strs
Exit For
End If
Next i
End Sub
'[]==========[]
'[]get0
'[]表达式分析，递归调用
'[]先建立两个栈，符号栈和数据栈
'[]向符号栈内先压入一个“#”号
'[]如果遇到数字，压入数字栈
'[]如果遇到“+”、“-”号，用Look函数察看符号栈顶是什么符号
'[] 如果是“#”号，把这个“+”或者“-”压入符号栈，如果是“+”或者“-”
'[] 就把前一步的运算先算了。并且把结果压栈，新的“+”、“-”号也压栈
'[]如果遇到“*”、“/”号，从数字栈中弹出一个数，从表达式中预取一个数，进行
'[] 运算，并且把结果压栈
'[]如果遇到“（”那么就递归调用了
'[]==========[]
Private Function get0() As String
Dim p0 As String
Dim p1 As String
Dim P(1 To 4) As String
Dim d(1 To 4) As String
Dim operator As String
Dim a As String
Dim b As String
Push P, "#"
Do
start:
theI = theI + 1
If IsNumeric(Decom(theI)) Then
Push d, Decom(theI)
Else
p0 = Look(P)
p1 = Decom(theI)
Select Case p1
Case "+"
Select Case p0
Case "#"
Push P, p1
Case "+"
operator = Pop(P)
b = Pop(d)
a = Pop(d)
Push d, Str(Val(a) + Val(b))
Push P, "+"
Case "-"
operator = Pop(P)
b = Pop(d)
a = Pop(d)
Push d, Str(Val(a) - Val(b))
Push P, "+"
Case Else
End Select
Case "-"
Select Case p0
Case "#"
Push P, p1
Case "+"
operator = Pop(P)
b = Pop(d)
a = Pop(d)
Push d, Str(Val(a) + Val(b))
Push P, "-"
Case "-"
operator = Pop(P)
b = Pop(d)
a = Pop(d)
Push d, Str(Val(a) - Val(b))
Push P, "-"
Case Else
End Select
Case "("
Select Case p0
Case "+"
Push d, get0()
GoTo start
Case "-"
Push d, get0()
GoTo start
Case "#"
Push d, get0()
GoTo start
Case Else
End Select
Case ")"
operator = Pop(P)
b = Pop(d)
a = Pop(d)
If operator = "#" Or a = "" Or b = "" Then
Push P, "#"
Push d, a
Push d, b
Else
Select Case operator
Case "+"
Push d, Str(Val(a) + Val(b))
Case "-"
Push d, Str(Val(a) - Val(b))
Case "*"
Push d, Str(Val(a) * Val(b))
Case "/"
Push d, Str(Val(a) / Val(b))
Case Else
End Select
End If
Case ""
operator = Pop(P)
b = Pop(d)
a = Pop(d)
If operator = "#" Or a = "" Or b = "" Then
Push P, "#"
Push d, a
Push d, b
Else
Select Case operator
Case "+"
Push d, Str(Val(a) + Val(b))
Case "-"
Push d, Str(Val(a) - Val(b))
Case "*"
Push d, Str(Val(a) * Val(b))
Case "/"
Push d, Str(Val(a) / Val(b))
Case Else
End Select
End If
Case "*"
If IsNumeric(Decom(theI + 1)) Then
theI = theI + 1
b = Decom(theI)
a = Pop(d)
Push d, Str(Val(a) * Val(b))
End If
If Decom(theI + 1) = "(" Then
a = Pop(d)
theI = theI + 1
Push d, Str(Val(a) * Val(get0()))
GoTo start
End If
Case "/"
If IsNumeric(Decom(theI + 1)) Then
theI = theI + 1
b = Decom(theI)
a = Pop(d)
Push d, Str(Val(a) / Val(b))
End If
If Decom(theI + 1) = "(" Then
a = Pop(d)
theI = theI + 1
Push d, Str(Val(a) / Val(get0()))
GoTo start
End If
Case ","
operator = Pop(P)
b = Pop(d)
a = Pop(d)
If operator = "#" Or a = "" Or b = "" Then
Push P, "#"
Push d, a
Push d, b
Else
Select Case operator
Case "+"
Push d, Str(Val(a) + Val(b))
Case "-"
Push d, Str(Val(a) - Val(b))
Case "*"
Push d, Str(Val(a) * Val(b))
Case "/"
Push d, Str(Val(a) / Val(b))
Case Else
End Select
End If
Exit Do
Case Else
End Select
End If
Loop Until Decom(theI) = ")" Or Decom(theI) = ""
get0 = Pop(d)
End Function
'[]==========[]
'[]getexp
'[]表达式求值
'[]==========[]
Private Function GetExp(ByVal strCodeLine As String) As String
Dim s As String
Dim i As Long
Seperate strCodeLine
i = 0
Do
i = i + 1
If Decom(i) = "(" Then
theI = i - 1
Decom(i) = get0
Exit Do
End If
Loop While Decom(i) <> ""
i = i + 1
Do
Decom(i) = ""
i = i + 1
Loop While Decom(i) <> ""
i = 0
Do
i = i + 1
s = s & Decom(i) & " "
Loop While Decom(i) <> ""
GetExp = s
End Function
'[]==========[]
'[]seperate
'[]分离一个字符串，存入数组decom中
'[]==========[]
Public Sub Seperate(ByVal strCodeLine As String)
Dim i As Long
Dim leng As Long
Dim c As String
Dim j As Long
Dim n As Long
leng = Len(strCodeLine)
n = 0
For i = 1 To 256
Decom(i) = ""
Next i
i = 0
Do
i = i + 1
c = Mid(strCodeLine, i, 1)
If c = " " Then
Do
i = i + 1
c = Mid(strCodeLine, i, 1)
Loop While c = " " And i <= leng
i = i - 1
ElseIf c = Chr(vbKeyTab) Then
Do
i = i + 1
c = Mid(strCodeLine, i, 1)
Loop While c = Chr(vbKeyTab) And i <= leng
i = i - 1
ElseIf c = "'" Then
j = i
Do
i = i + 1
c = Mid(strCodeLine, i, 1)
Loop While c <> "'" And i <= leng
n = n + 1
Decom(n) = Trim(Mid(strCodeLine, j, i - j + 1))
ElseIf c = "<" Then
n = n + 1
Decom(n) = "<"
ElseIf c = ">" Then
n = n + 1
Decom(n) = ">"
ElseIf c = "[" Then
n = n + 1
Decom(n) = "["
ElseIf c = "]" Then
n = n + 1
Decom(n) = "]"