[VBA程序]：公式解析源代码，仅包含四则运算部分。

efan2000

花了两天时间，终于将一个C#编写的公式解析程序转化为VB的代码，不过还有很多东西没有实现，比如函数和变量功能的实现，有兴趣的可以自己研究，也可以参考编译原理这本书。

2. 
   
3. 
   
4.   [FONT=courier new]
   
5. Enum tokTypes
   
6.     tokNONE = 0
   
7.     tokDELIMITER = 1
   
8.     tokVARIABLE = 2
   
9.     tokFUNCTION = 3
   
10.     tokNumber = 4
    
11.     tokString = 5
    
12. End Enum
    
13. Dim exp As String
    
14. Dim expIdx As Integer
    
15. Dim token As String
    
16. Dim tokType As tokTypes
    
17. 
    
18. ' 判断是否指定的分隔符
    
19. Function IsDelim(ByVal c As String) As Boolean
    
20.     If InStr("+-*/&()", c) Then IsDelim = True
    
21. End Function
    
22. 
    
23. ' 判断是否是字母
    
24. Function IsLetter(ByVal c As String) As Boolean
    
25.     If Asc(c) >= 65 And Asc(c) <= 90 Then
    
26.         IsLetter = True
    
27.     ElseIf Asc(c) >= 97 And Asc(c) <= 122 Then
    
28.         IsLetter = True
    
29.     End If
    
30. End Function
    
31. 
    
32. '判断是否是数字
    
33. Function IsDigit(ByVal c As String) As Boolean
    
34.     If Asc(c) >= 48 And Asc(c) <= 57 Then IsDigit = True
    
35. End Function
    
36. 
    
37. '判断是否是空格
    
38. Function IsWhiteSpace(ByVal c As String) As Boolean
    
39.     If c = " " Then IsWhiteSpace = True
    
40. End Function
    
41. 
    
42. '取计算单元标记
    
43. Sub GetToken()
    
44.     tokType = tokNONE
    
45.     token = ""
    
46.     If expIdx > Len(exp) Then Exit Sub
    
47.     '忽略前置空格
    
48.     Do While (expIdx <= Len(exp) And IsWhiteSpace(Mid(exp, expIdx, 1)))
    
49.         expIdx = expIdx + 1
    
50.         If expIdx > Len(exp) Then Exit Sub
    
51.     Loop
    
52.     '分隔符
    
53.     If (IsDelim(Mid(exp, expIdx, 1))) Then
    
54.         token = token + Mid(exp, expIdx, 1)
    
55.         expIdx = expIdx + 1
    
56.         tokType = tokDELIMITER
    
57.     '函数或者变量
    
58.     ElseIf (IsLetter(Mid(exp, expIdx, 1))) Then
    
59.        token = token + Mid(exp, expIdx, 1)
    
60.         expIdx = expIdx + 1
    
61.         If expIdx > Len(exp) Then Exit Sub
    
62.         Do While (IsLetter(Mid(exp, expIdx, 1)) And IsDigit(Mid(exp, expIdx, 1)))
    
63.             token = token + Mid(exp, expIdx, 1)
    
64.             expIdx = expIdx + 1
    
65.             If expIdx > Len(exp) Then Exit Do
    
66.         Loop
    
67.         tokType = tokFUNCTION
    
68.     '数字
    
69.     ElseIf (IsDigit(Mid(exp, expIdx, 1))) Then
    
70.         Do While Not (IsDelim(Mid(exp, expIdx, 1)))
    
71.             token = token + Mid(exp, expIdx, 1)
    
72.             expIdx = expIdx + 1
    
73.             If expIdx > Len(exp) Then Exit Do
    
74.         Loop
    
75.         tokType = tokNumber
    
76.     '字符串
    
77.     ElseIf (Mid(exp, expIdx, 1) = """") Then
    
78.         expIdx = expIdx + 1
    
79.         Do While (Mid(exp, expIdx, 1) <> """")
    
80.             token = token + Mid(exp, expIdx, 1)
    
81.             expIdx = expIdx + 1
    
82.             If expIdx > Len(exp) Then Exit Do
    
83.         Loop
    
84.         expIdx = expIdx + 1
    
85.         tokType = tokString
    
86.     End If
    
87. End Sub
    
88. 
    
89. Function Evaluate(ByVal expstr As String)
    
90.     exp = expstr
    
91.     expIdx = 1
    
92.     GetToken
    
93.     If (tokType = tokNONE And token = """") Then MsgBox ("No Expression Present!")
    
94.     Evaluate = EvalExp2()
    
95.     MsgBox Evaluate
    
96. End Function
    
97. 
    
98. '处理加法或减法
    
99. Function EvalExp2() As String
    
100.     Dim result As String
     
101.     Dim op As String
     
102.     Dim partialResult As String
     
103.     EvalExp2 = EvalExp3()
     
104.     op = token
     
105.     Do While (op = "+" Or op = "-" Or op = "&")
     
106.         GetToken
     
107.         partialResult = EvalExp3()
     
108.         Select Case op
     
109.             Case "-":
     
110.                 EvalExp2 = CDbl(EvalExp2) - CDbl(partialResult)
     
111.             Case "+":
     
112.                 EvalExp2 = CDbl(EvalExp2) + CDbl(partialResult)
     
113.             Case "&":
     
114.                 EvalExp2 = EvalExp2 + partialResult
     
115.         End Select
     
116.         op = token
     
117.     Loop
     
118. End Function
     
119. 
     
120. '处理乘法或除法
     
121. Function EvalExp3() As String
     
122.     Dim op As String
     
123.     Dim partialResult  As String
     
124.     EvalExp3 = EvalExp5
     
125.     op = token
     
126.     Do While (op = "*" Or op = "/")
     
127.         GetToken
     
128.         partialResult = EvalExp5
     
129.         Select Case op
     
130.             Case "*":
     
131.                 EvalExp3 = CDbl(EvalExp3) * CDbl(partialResult)
     
132.             Case "/":
     
133.                 EvalExp3 = CDbl(EvalExp3) / CDbl(partialResult)
     
134.         End Select
     
135.         op = token
     
136.     Loop
     
137. End Function
     
138. 
     
139. '处理一元
     
140. Function EvalExp5() As String
     
141.     Dim op As String
     
142.     Dim partialResult  As String
     
143.     op = ""
     
144.     If ((tokType = tokDELIMITER) And (token = "+" Or token = "-")) Then
     
145.         op = token
     
146.         GetToken
     
147.     End If
     
148.     EvalExp5 = EvalExp6
     
149.     If (op = "-") Then EvalExp5 = -1 * EvalExp5
     
150. End Function
     
151. 
     
152. '处理括号
     
153. Function EvalExp6() As String
     
154.     If ((token = "(")) Then
     
155.         GetToken
     
156.         EvalExp6 = EvalExp2()
     
157.         GetToken
     
158.     Else
     
159.         EvalExp6 = Atom()
     
160.     End If
     
161. End Function
     
162. 
     
163. '处理数字或字符串
     
164. Function Atom() As String
     
165.     Select Case tokType
     
166.         Case tokNumber:
     
167.             Atom = token
     
168.             GetToken
     
169.         Case tokString:
     
170.             Atom = token
     
171.             GetToken
     
172.     End Select
     
173. End Function
     
174. 
     
175. Sub main()
     
176.     Evaluate "(3+5)*((2.5+7.5)-8/2)"
     
177. End Sub
     
178.   [/FONT]
     

<br /> <br />   [FONT=courier new]<br /> Enum tokTypes<br />     tokNONE = 0<br />     tokDELIMITER = 1<br />     tokVARIABLE = 2<br />     tokFUNCTION = 3<br />     tokNumber = 4<br />     tokString = 5<br /> End Enum<br /> Dim exp As String<br /> Dim expIdx As Integer<br /> Dim token As String<br /> Dim tokType As tokTypes<br /> <br /> ' 判断是否指定的分隔符<br /> Function IsDelim(ByVal c As String) As Boolean<br />     If InStr("+-*/&()", c) Then IsDelim = True<br /> End Function<br /> <br /> ' 判断是否是字母<br /> Function IsLetter(ByVal c As String) As Boolean<br />     If Asc(c) >= 65 And Asc(c) <= 90 Then<br />         IsLetter = True<br />     ElseIf Asc(c) >= 97 And Asc(c) <= 122 Then<br />         IsLetter = True<br />     End If<br /> End Function<br /> <br /> '判断是否是数字<br /> Function IsDigit(ByVal c As String) As Boolean<br />     If Asc(c) >= 48 And Asc(c) <= 57 Then IsDigit = True<br /> End Function<br /> <br /> '判断是否是空格<br /> Function IsWhiteSpace(ByVal c As String) As Boolean<br />     If c = " " Then IsWhiteSpace = True<br /> End Function<br /> <br /> '取计算单元标记<br /> Sub GetToken()<br />     tokType = tokNONE<br />     token = ""<br />     If expIdx > Len(exp) Then Exit Sub<br />     '忽略前置空格<br />     Do While (expIdx <= Len(exp) And IsWhiteSpace(Mid(exp, expIdx, 1)))<br />         expIdx = expIdx + 1<br />         If expIdx > Len(exp) Then Exit Sub<br />     Loop<br />     '分隔符<br />     If (IsDelim(Mid(exp, expIdx, 1))) Then<br />         token = token + Mid(exp, expIdx, 1)<br />         expIdx = expIdx + 1<br />         tokType = tokDELIMITER<br />     '函数或者变量<br />     ElseIf (IsLetter(Mid(exp, expIdx, 1))) Then<br />        token = token + Mid(exp, expIdx, 1)<br />         expIdx = expIdx + 1<br />         If expIdx > Len(exp) Then Exit Sub<br />         Do While (IsLetter(Mid(exp, expIdx, 1)) And IsDigit(Mid(exp, expIdx, 1)))<br />             token = token + Mid(exp, expIdx, 1)<br />             expIdx = expIdx + 1<br />             If expIdx > Len(exp) Then Exit Do<br />         Loop<br />         tokType = tokFUNCTION<br />     '数字<br />     ElseIf (IsDigit(Mid(exp, expIdx, 1))) Then<br />         Do While Not (IsDelim(Mid(exp, expIdx, 1)))<br />             token = token + Mid(exp, expIdx, 1)<br />             expIdx = expIdx + 1<br />             If expIdx > Len(exp) Then Exit Do<br />         Loop<br />         tokType = tokNumber<br />     '字符串<br />     ElseIf (Mid(exp, expIdx, 1) = """") Then<br />         expIdx = expIdx + 1<br />         Do While (Mid(exp, expIdx, 1) <> """")<br />             token = token + Mid(exp, expIdx, 1)<br />             expIdx = expIdx + 1<br />             If expIdx > Len(exp) Then Exit Do<br />         Loop<br />         expIdx = expIdx + 1<br />         tokType = tokString<br />     End If<br /> End Sub<br /> <br /> Function Evaluate(ByVal expstr As String)<br />     exp = expstr<br />     expIdx = 1<br />     GetToken<br />     If (tokType = tokNONE And token = """") Then MsgBox ("No Expression Present!")<br />     Evaluate = EvalExp2()<br />     MsgBox Evaluate<br /> End Function<br /> <br /> '处理加法或减法<br /> Function EvalExp2() As String<br />     Dim result As String<br />     Dim op As String<br />     Dim partialResult As String<br />     EvalExp2 = EvalExp3()<br />     op = token<br />     Do While (op = "+" Or op = "-" Or op = "&")<br />         GetToken<br />         partialResult = EvalExp3()<br />         Select Case op<br />             Case "-":<br />                 EvalExp2 = CDbl(EvalExp2) - CDbl(partialResult)<br />             Case "+":<br />                 EvalExp2 = CDbl(EvalExp2) + CDbl(partialResult)<br />             Case "&":<br />                 EvalExp2 = EvalExp2 + partialResult<br />         End Select<br />         op = token<br />     Loop<br /> End Function<br /> <br /> '处理乘法或除法<br /> Function EvalExp3() As String<br />     Dim op As String<br />     Dim partialResult  As String<br />     EvalExp3 = EvalExp5<br />     op = token<br />     Do While (op = "*" Or op = "/")<br />         GetToken<br />         partialResult = EvalExp5<br />         Select Case op<br />             Case "*":<br />                 EvalExp3 = CDbl(EvalExp3) * CDbl(partialResult)<br />             Case "/":<br />                 EvalExp3 = CDbl(EvalExp3) / CDbl(partialResult)<br />         End Select<br />         op = token<br />     Loop<br /> End Function<br /> <br /> '处理一元<br /> Function EvalExp5() As String<br />     Dim op As String<br />     Dim partialResult  As String<br />     op = ""<br />     If ((tokType = tokDELIMITER) And (token = "+" Or token = "-")) Then<br />         op = token<br />         GetToken<br />     End If<br />     EvalExp5 = EvalExp6<br />     If (op = "-") Then EvalExp5 = -1 * EvalExp5<br /> End Function<br /> <br /> '处理括号<br /> Function EvalExp6() As String<br />     If ((token = "(")) Then<br />         GetToken<br />         EvalExp6 = EvalExp2()<br />         GetToken<br />     Else<br />         EvalExp6 = Atom()<br />     End If<br /> End Function<br /> <br /> '处理数字或字符串<br /> Function Atom() As String<br />     Select Case tokType<br />         Case tokNumber:<br />             Atom = token<br />             GetToken<br />         Case tokString:<br />             Atom = token<br />             GetToken<br />     End Select<br /> End Function<br /> <br /> Sub main()<br />     Evaluate "(3+5)*((2.5+7.5)-8/2)"<br /> End Sub<br />   [/FONT]<br />

efan2000

附上它的代码分析程序，是C#格式，可以参考。
没接触过C#的编程，可能转化的过程当中有些不是处理的很好，另外错误分析的部分也没处理。
附件是用WinRAR3.20版本压缩的，如果打不开，请下载新的版本。

zeng29

如果不想用MSC的话,可以用这个CalExp类.
我在明经曾经贴过的.这是最新版:

aeo

我想不是你自己写的吧
http://www.freevbcode.com
这上面的吧.
自己写也有自己的乐趣.^_^


顺便请教个问题：
比如一个文件里面有几个字:
比如是 ACAD , 文件里是:  41 42 41 43  (用二进制写进去)
dim a as string
dim b(3) as byte
open "1.txt" For Binary as 1#
get 1#,, a
这里a就为"ACAD"
如果get 1# ,, b
b(0 1 2 3)就分别为(65 67 65 68)
那照理 如a = b ,那a就为"ACAD",可并不这样,
我知道"ACAD"要八个字节,-->(65 0 67 0 65 0 68 0)
但那文件就4个字节它怎么a就可以是"ACAD"呢?而以byte读出，又不是了?