VB icon

Eval (Evaluate String Expression) *REPOST*

Email
Submitted on: 1/16/2015 4:16:00 AM
By: Aldo Vargas (from psc cd)  
Level: Intermediate
User Rating: By 9 Users
Compatibility: VB 3.0, VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0, VB Script, ASP (Active Server Pages) , VBA MS Access, VBA MS Excel
Views: 1697
 
     This is a recursive function that evaluates strings expressions. It supports multiple levels of parenthesis, algebraic evaluation of expressions (in this example exponentiation ^ has same level of multiplication and division), function calls, logical operators, string/date/numeric functions and expresion evaluation. This is the base for the creation of a scripting language.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Eval (Evaluate String Expression) *REPOST*
' Description:This is a recursive function that evaluates strings expressions. It supports multiple levels of parenthesis, algebraic evaluation of expressions (in this example
exponentiation ^ has same level of multiplication and division), function calls, logical operators, string/date/numeric functions and expresion evaluation. This is the base for
the creation of a scripting language.
' By: Aldo Vargas (from psc cd)
'
' Assumes:Logical evaluations requires that expressions be inside parenthesis. Example: ((-1) and (-1)) or (-1)
'**************************************

Public Function Eval(expr As String)
 Dim value As Variant, operand As String
 Dim pos As Integer
 
 pos = 1
 Do Until pos > Len(expr)
Select Case Mid(expr, pos, 3)
 Case "not", "or ", "and", "xor", "eqv", "imp"
 operand = Mid(expr, pos, 3)
 pos = pos + 3
End Select
Select Case Mid(expr, pos, 1)
 Case " "
pos = pos + 1
 Case "&", "+", "-", "*", "/", "\", "^"
operand = Mid(expr, pos, 1)
pos = pos + 1
 Case ">", "<", "=":
Select Case Mid(expr, pos + 1, 1)
 Case "<", ">", "="
operand = Mid(expr, pos, 2)
pos = pos + 1
 Case Else
operand = Mid(expr, pos, 1)
End Select
pos = pos + 1
 Case Else
Select Case operand
Case "": value = Token(expr, pos)
Case "&": Eval = Eval & value
 value = Token(expr, pos)
Case "+": Eval = Eval + value
 value = Token(expr, pos)
Case "-": Eval = Eval + value
 value = -Token(expr, pos)
 
Case "*": value = value * Token(expr, pos)
Case "/": value = value / Token(expr, pos)
Case "\": value = value \ Token(expr, pos)
Case "^": value = value ^ Token(expr, pos)
Case "not": Eval = Eval + value
 value = Not Token(expr, pos)
Case "and": value = value And Token(expr, pos)
Case "or ": value = value Or Token(expr, pos)
Case "xor": value = value Xor Token(expr, pos)
Case "eqv": value = value Eqv Token(expr, pos)
Case "imp": value = value Imp Token(expr, pos)
Case "=", "==": value = value = Token(expr, pos)
Case ">": value = value > Token(expr, pos)
Case "<": value = value < Token(expr, pos)
Case ">=", "=>": value = value >= Token(expr, pos)
Case "<=", "=<": value = value <= Token(expr, pos)
Case "<>": value = value <> Token(expr, pos)
End Select
End Select
 Loop
 
 Eval = Eval + value
End Function
Private Function Token(expr, pos)
 Dim char As String, value As String, fn As String
 Dim es As Integer, pl As Integer
 Const QUOTE As String = """"
 
 Do Until pos > Len(expr)
char = Mid(expr, pos, 1)
Select Case char
Case "&", "+", "-", "/", "\", "*", "^", " ", ">", "<", "=": Exit Do
Case "("
 pl = 1
 pos = pos + 1
 es = pos
 Do Until pl = 0 Or pos > Len(expr)
char = Mid(expr, pos, 1)
Select Case char
 Case "(": pl = pl + 1
 Case ")": pl = pl - 1
End Select
pos = pos + 1
 Loop
 value = Mid(expr, es, pos - es - 1)
 fn = LCase(Token)
 Select Case fn
Case "sin": Token = Sin(Eval(value))
Case "cos": Token = Cos(Eval(value))
Case "tan": Token = Tan(Eval(value))
Case "exp": Token = Exp(Eval(value))
Case "log": Token = Log(Eval(value))
Case "atn": Token = Atn(Eval(value))
Case "abs": Token = Abs(Eval(value))
Case "sgn": Token = Sgn(Eval(value))
Case "sqr": Token = Sqr(Eval(value))
Case "rnd": Token = Rnd(Eval(value))
Case "int": Token = Int(Eval(value))
Case "day": Token = Day(Eval(value))
Case "month": Token = Month(Eval(value))
Case "year": Token = Year(Eval(value))
Case "weekday": Token = WeekDay(Eval(value))
Case "hour": Token = Hour(Eval(value))
Case "minute": Token = Minute(Eval(value))
Case "second": Token = Second(Eval(value))
Case "date": Token = Date
Case "date$": Token = Date$
Case "time": Token = Time
Case "time$": Token = Time$
Case "timer": Token = Timer
Case "now": Token = Now()
Case "len": Token = Len(Eval(value))
Case "trim": Token = Trim(Eval(value))
Case "ltrim": Token = LTrim(Eval(value))
Case "rtrim": Token = RTrim(Eval(value))
Case "ucase": Token = UCase(Eval(value))
Case "lcase": Token = LCase(Eval(value))
Case "val": Token = Val(Eval(value))
Case "chr": Token = Chr(Eval(value))
Case "asc": Token = Asc(Eval(value))
Case "space": Token = Space(Eval(value))
Case "hex": Token = Hex(Eval(value))
Case "oct": Token = Oct(Eval(value))
Case "environ": Token = Environ$(Eval(value))
Case "curdir": Token = CurDir$
Case "dir": If Len(value) Then Token = Dir(Eval(value)) Else Token = Dir
Case Else: Token = Eval(value)
 End Select
 Exit Do
Case QUOTE
 pl = 1
 pos = pos + 1
 es = pos
 Do Until pl = 0 Or pos > Len(expr)
char = Mid(expr, pos, 1)
pos = pos + 1
If char = QUOTE Then
 If Mid(expr, pos, 1) = QUOTE Then
value = value & QUOTE
pos = pos + 1
 Else
Exit Do
 End If
Else
 value = value & char
End If
 Loop
 Token = value
 Exit Do
Case Else
 Token = Token & char
 pos = pos + 1
End Select
 Loop
 
 If IsNumeric(Token) Then
Token = Val(Token)
 ElseIf IsDate(Token) Then
Token = CDate(Token)
 End If
End Function


Other 4 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.