如何解析字符串

yanxiguang_0 2008-10-15 08:20:52
我是个新手遇到个问题

dim str as string
str=a*(b+c)
a,b,c 是从数据库里取到的值
我现在想做的好是如何算出str的值

如何解析字符串
...全文
128 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
gytzExcel 2008-10-15
  • 打赏
  • 举报
回复
ding
Forrest23 2008-10-15
  • 打赏
  • 举报
回复
http://topic.csdn.net/u/20080130/16/2b246012-3a38-405c-ab9f-d215e9355a1a.html
Forrest23 2008-10-15
  • 打赏
  • 举报
回复
我以前做过,需要用到表达式的解析
还需要支持符号等
还会用到递归
比较麻烦就是了,贴个代码给你
自己找里面有用的
'-------------------------------------------------
'日期:2005-11-9
'设计:刘志勇
'编码:刘志勇
'说明:工资项目计算公式生成器,可验证公式的有效性
'-------------------------------------------------
Option Explicit

Private mFields() As String '可用于公式中的数据库字段

Private mWIID As Integer
Const Operator As String = "+-*/> <()"

Public Event Done(strExp As String, strDis As String)

Public Property Let WIID(ByVal iID As Integer)
mWIID = iID
End Property
Public Property Let Expression(ByVal strExp As String)
txtExp.Text = strExp
txtExp.SelStart = Len(strExp)
End Property

'-----------------------------------------------------
'检查表达式的是否正确有效
'-----------------------------------------------------
Public Function CheckValid(strExp As String) As Boolean
Dim i As Integer
Dim strTmp As String
Dim s As Integer
Dim start As Integer
Dim send As Integer

s = 0
strTmp = strExp
start = 1
For i = 1 To Len(strExp)
If Mid(strExp, i, 1) = "(" Then
If s = 0 Then
start = i
End If
s = s - 1
End If

If Mid(strExp, i, 1) = ")" Then
send = i
s = s + 1
If s = 0 Then
If CheckValid(Mid(strExp, start + 1, send - start - 1)) = True Then
strTmp = Replace(strTmp, Mid(strExp, start, send - start + 1), "$")
Else
CheckValid = False
Exit Function
End If
End If
End If
Next i

CheckValid = IIf(CheckExceptBrack(strTmp) = True, True, False)

End Function

'----------------------------------------------------------
'检查不包含括号的表达式的有效性
'----------------------------------------------------------
Public Function CheckExceptBrack(strExp As String) As Boolean
Dim strTmp As String
Dim i As Integer
Dim s As Boolean
Dim rlt As Integer
Dim Fds() As String

s = 0
rlt = -1
CheckExceptBrack = False
strTmp = ReplaceOpterater(strExp)

Fds = Split(strTmp, " ", -1, vbTextCompare)
For i = 0 To UBound(Fds)
If IsDatabaseField(Fds(i)) = False And IsNumeric(Fds(i)) = False Then
CheckExceptBrack = False
Exit Function
End If
Next i

For i = 1 To Len(strExp)
If Mid(strTmp, i, 1) = Mid(strExp, i, 1) Then
If s = False Then
s = True
rlt = rlt + 1
If rlt > 0 Then Exit Function
End If
Else
s = False
rlt = rlt - 1
If rlt < -1 Then Exit Function
End If
Next i
If rlt = 0 Then
CheckExceptBrack = True
End If
End Function

'------------------------------------------------------
'将表达式中的操作符用空格替换掉
'------------------------------------------------------
Public Function ReplaceOpterater(strExpression As String) As String
Dim i As Integer
Dim strTmp As String

strTmp = strExpression

For i = 1 To 8
strTmp = Replace(strTmp, Mid(Operator, i, 1), " ")
Next i
ReplaceOpterater = strTmp

End Function

'--------------------------------------------------------
'判断字符串是否是数据库中的字段
'--------------------------------------------------------
Public Function IsDatabaseField(strCheck As String) As Boolean
Dim i As Integer
If strCheck = "$" Then
IsDatabaseField = True
Exit Function
End If

For i = 0 To UBound(mFields, 2)
If strCheck = mFields(0, i) Then
IsDatabaseField = True
Exit Function
End If
Next i



IsDatabaseField = False
End Function


Private Function CreateExp(strExp As String) As String
Dim i As Integer, j As Integer
Dim strTemp As String
Dim strItems() As String
Dim strNewExp As String

strTemp = strExp

strTemp = Replace(strTemp, "+", "#")
strTemp = Replace(strTemp, "-", "#")
strTemp = Replace(strTemp, "*", "#")
strTemp = Replace(strTemp, "/", "#")
strTemp = Replace(strTemp, "(", "#")
strTemp = Replace(strTemp, ")", "#")

strItems = Split(strTemp, "#")


For i = 0 To UBound(strItems)
For j = 0 To UBound(mFields, 2)
If strItems(i) = mFields(0, j) Then
strItems(i) = mFields(2, j)
Exit For
End If
Next j
Next i

j = 0
For i = 1 To Len(strExp)
If Mid(strExp, i, 1) <> Mid(strTemp, i, 1) Then
strNewExp = strNewExp & strItems(j) & Mid(strExp, i, 1)
j = j + 1
End If
Next i

strNewExp = "(" & strNewExp & strItems(j) & ")"
CreateExp = strNewExp

End Function


Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdCheckValid_Click()
If CheckValid(txtExp.Text) = True Then
MsgBox "计算公式验证结果正确!", vbOKOnly + vbInformation, App.ProductName
Else
MsgBox "计算公式格式不正确!", vbOKOnly + vbInformation, App.ProductName
End If
End Sub

Private Sub cmdInput_Click(Index As Integer)
Dim pos As Integer
Dim strText As String

strText = txtExp.Text
pos = txtExp.SelStart
txtExp.Text = Left(strText, pos) & cmdInput(Index).Caption & VBA.Right(strText, VBA.Len(strText) - pos)
txtExp.SelStart = pos + 1
txtExp.SetFocus
End Sub

Private Sub cmdOK_Click()
If CheckValid(txtExp.Text) = False Then
MsgBox "计算公式输入不正确!", vbOKOnly + vbInformation, App.ProductName
Else
RaiseEvent Done(CreateExp(txtExp.Text), txtExp.Text)
Unload Me
End If
End Sub

Private Sub Form_Load()
Call InitForm
txtExp.SelStart = Len(txtExp.Text)
End Sub

'----------------------------------------------------------------------
'初始化UcGridDA;初始化数据库字段,保存到数组中
'----------------------------------------------------------------------
Private Sub InitForm()

Dim puArrayColInfo() As puHEADSTRUCT
Dim lTmpCol As Long
Dim puArrayRowInfo(16) As puHEADSTRUCT
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim cnt As Integer

cnt = -1
lTmpCol = 1
ReDim puArrayColInfo(lTmpCol)

puArrayColInfo(0).sCaption = "编号"
puArrayColInfo(0).lWidth = 500
puArrayColInfo(0).lAlign = 0

puArrayColInfo(1).sCaption = "可参与计算的项目"
puArrayColInfo(1).lWidth = 2000
puArrayColInfo(1).lAlign = 0

UcGrid1.subDrawGrid puArrayColInfo, puArrayRowInfo

strSQL = "SELECT FDDictID,FDName,FDFieldName,FDExpression FROM FieldDict WHERE FDDictID <" & mWIID

rst.ActiveConnection = glbConnString
rst.CursorLocation = adUseClient
rst.Open strSQL
UcGrid1.subSetRecordSet rst.Clone
With rst
Do While Not .EOF
cnt = cnt + 1
ReDim Preserve mFields(2, cnt)
mFields(0, cnt) = Trim(!FdName)
mFields(1, cnt) = Trim(!FDExpression)
mFields(2, cnt) = Trim(!FDFieldName)

.MoveNext
Loop
End With

rst.Close
Set rst = Nothing

End Sub


Private Sub UcGrid1_DblClick()
Dim strDisp As String
Dim pos As Integer
Dim strText As String

If UcGrid1.CurRow > 0 Then
strDisp = Trim(UcGrid1.DisplayText(UcGrid1.CurRow, 1))
If strDisp <> "" Then
strText = txtExp.Text
pos = txtExp.SelStart
txtExp.Text = Left(strText, pos) & strDisp & VBA.Right(strText, VBA.Len(strText) - pos)
txtExp.SelStart = pos + Len(strDisp)
End If
End If
txtExp.SetFocus
End Sub
Forrest23 2008-10-15
  • 打赏
  • 举报
回复
帮顶~
一只熊猫 2008-10-15
  • 打赏
  • 举报
回复

是 str=chr(a*b+c) 的意思么?
rockyvan 2008-10-15
  • 打赏
  • 举报
回复
[Quote=引用楼主 yanxiguang_0 的帖子:]
dim str as string
str=a*(b+c)
a,b,c 是从数据库里取到的值
我现在想做的好是如何算出str的值
[/Quote]
Dim str As String
str = a*(b+c).ToString
yangpeiyu 2008-10-15
  • 打赏
  • 举报
回复


你从数据取出来后要转成整形然后再进行运算,运算完后用.ToString()转成字符赋给str就可以了.

16,554

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧