Eval (Evaluate String Expression) *REPOST*
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.
Original Author: Aldo Vargas
Assumptions
Logical evaluations requires that expressions be inside parenthesis. Example: ((-1) and (-1)) or (-1)
Code
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
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.