Option Explicit On Option Strict On ''' ''' Represents a command parser and expression evaluator. ''' ''' Public Class PARSER Private Const UNARYMARK As String = ""c 'Chr(127) Public Delegate Function EvaluateCallback(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Public Delegate Function VirtualFunctionCall(ByVal Args() As ValueClass) As ValueClass Private Shared Operators As New OperatorsCol Private Shared Functions As New VirtualFunctionsTable Shared Sub New() SetOperators() SetBuiltinFunctions() ' Set evaluation functions for operators and functions Operators("++").SetEvaluatorCallback(AddressOf PostfixIncrement) Operators("--").SetEvaluatorCallback(AddressOf PostfixDecrement) Operators(UNARYMARK + "++").SetEvaluatorCallback(AddressOf PrefixIncrement) Operators(UNARYMARK + "--").SetEvaluatorCallback(AddressOf PrefixDecrement) Operators(UNARYMARK + "-").SetEvaluatorCallback(AddressOf UnaryMinus) Operators(UNARYMARK + "+").SetEvaluatorCallback(AddressOf UnaryPlus) Operators("**").SetEvaluatorCallback(AddressOf PowerOf) Operators(UNARYMARK + "!").SetEvaluatorCallback(AddressOf BitwiseNot) Operators(UNARYMARK + "not").SetEvaluatorCallback(AddressOf BitwiseNot) Operators(UNARYMARK + "&").SetEvaluatorCallback(AddressOf Address_Of) Operators("*").SetEvaluatorCallback(AddressOf Multiply) Operators("/").SetEvaluatorCallback(AddressOf Divide) Operators("\").SetEvaluatorCallback(AddressOf IntegerDivide) Operators("%").SetEvaluatorCallback(AddressOf Modulus) Operators("+").SetEvaluatorCallback(AddressOf Addition) Operators("-").SetEvaluatorCallback(AddressOf Subtraction) Operators("<<").SetEvaluatorCallback(AddressOf LeftShift) Operators(">>").SetEvaluatorCallback(AddressOf RightShift) Operators("<").SetEvaluatorCallback(AddressOf LessThan) Operators("<=").SetEvaluatorCallback(AddressOf LessThanOrEqual) Operators(">").SetEvaluatorCallback(AddressOf GreaterThan) Operators(">=").SetEvaluatorCallback(AddressOf GreaterThanOrEqual) Operators("=").SetEvaluatorCallback(AddressOf Equality) Operators("!=").SetEvaluatorCallback(AddressOf NotEqual) Operators("<>").SetEvaluatorCallback(AddressOf NotEqual) Operators("&").SetEvaluatorCallback(AddressOf BitwiseAND) Operators("^").SetEvaluatorCallback(AddressOf BitwiseXOR) Operators("|").SetEvaluatorCallback(AddressOf BitwiseOR) Operators("&&").SetEvaluatorCallback(AddressOf LogicalAND) Operators("and").SetEvaluatorCallback(AddressOf LogicalAND) Operators("||").SetEvaluatorCallback(AddressOf LogicalOR) Operators("or").SetEvaluatorCallback(AddressOf LogicalOR) Operators("=").SetEvaluatorCallback(AddressOf Assignment) Operators("-=").SetEvaluatorCallback(AddressOf AssignmentByDifference) Operators("+=").SetEvaluatorCallback(AddressOf AssignmentBySum) Operators("*=").SetEvaluatorCallback(AddressOf AssignmentByProduct) Operators("/=").SetEvaluatorCallback(AddressOf AssignmentByQuotient) Operators("\=").SetEvaluatorCallback(AddressOf AssignmentByIntegerQuotient) Operators("%=").SetEvaluatorCallback(AddressOf AssignmentByModulus) Functions("byte").SetVirtualCall(AddressOf _Byte) Functions("int").SetVirtualCall(AddressOf _Int) Functions("bool").SetVirtualCall(AddressOf _Bool) Functions("text").SetVirtualCall(AddressOf _Text) Functions("float").SetVirtualCall(AddressOf _Float) Functions("format").SetVirtualCall(AddressOf _Format) Functions("sin").SetVirtualCall(AddressOf _Sin) Functions("cos").SetVirtualCall(AddressOf _Cos) Functions("tan").SetVirtualCall(AddressOf _Tan) Functions("sqrt").SetVirtualCall(AddressOf _Sqrt) Functions("abs").SetVirtualCall(AddressOf _Abs) Functions("acos").SetVirtualCall(AddressOf _Acos) Functions("asin").SetVirtualCall(AddressOf _Asin) Functions("atan").SetVirtualCall(AddressOf _Atan) Functions("exp").SetVirtualCall(AddressOf _Exp) Functions("ln").SetVirtualCall(AddressOf _Ln) Functions("log").SetVirtualCall(AddressOf _Log) Functions("lg").SetVirtualCall(AddressOf _Lg) Functions("max").SetVirtualCall(AddressOf _Max) Functions("min").SetVirtualCall(AddressOf _Min) Functions("round").SetVirtualCall(AddressOf _Round) Functions("sign").SetVirtualCall(AddressOf _Sign) Functions("fix").SetVirtualCall(AddressOf _Fix) Functions("left").SetVirtualCall(AddressOf _Left) Functions("right").SetVirtualCall(AddressOf _Right) Functions("len").SetVirtualCall(AddressOf _Len) Functions("substr").SetVirtualCall(AddressOf _Substr) Functions("seek").SetVirtualCall(AddressOf _Seek) Functions("ucase").SetVirtualCall(AddressOf _UCase) Functions("lcase").SetVirtualCall(AddressOf _LCase) Functions("trim").SetVirtualCall(AddressOf _Trim) Functions("chr").SetVirtualCall(AddressOf _Chr) Functions("chrw").SetVirtualCall(AddressOf _ChrW) Functions("asc").SetVirtualCall(AddressOf _Asc) Functions("ascw").SetVirtualCall(AddressOf _AscW) Functions("replace").SetVirtualCall(AddressOf _Replace) End Sub ''' ''' Parses a user input. ''' ''' ''' ''' Public Shared Function ParseCommand(ByVal Command As String) As String Dim ret As String = "" Dim tokens() As String Try tokens = Tokenize(Command) 'ret = "Tokenization results:" & ControlChars.CrLf 'For Each s In tokens ' ret += (s + " ") 'Next 'ret += (ControlChars.CrLf + "Infix -> Postfix results:" + ControlChars.CrLf) Dim PostFixTokens() As String = InfixToPostFix(tokens) 'For Each s In PostFixTokens ' ret += (s + " ") 'Next 'ret += (ControlChars.CrLf + "Postfix evaluation result:" + ControlChars.CrLf) Dim result As ValueClass = EvaluatePostFix(PostFixTokens) ret += result.Value.ToString Catch ex As SyntaxErrorException ret = ex.Message Catch ex As ArgumentException ret = ex.Message Catch ex As DivideByZeroException ret = ex.Message Catch ex As Exception ret = ex.Message End Try Return ret End Function ''' ''' Tokenizes a given command. ''' ''' A commant to tokenize. ''' Array or string tokens ''' Unary prefix operators are marked with UNARYMARK string constant. Private Shared Function Tokenize(ByVal command As String) As String() Dim c As Char, x As Integer ' We enqueue all encountered tokens here Dim ret As New Queue(Of String) Dim ParsingString As Boolean = False ' This is a token currently being built Dim CurrentToken As String = "" ' This is a flag indicating that this is the last character in the command line Dim EOL As Boolean = False ' This holds the next character Dim nextchar As Char = ControlChars.NullChar For x = 0 To command.Length - 1 c = command(x) ' Determining the next character or end of command line If x < command.Length - 1 Then nextchar = command(x + 1) Else nextchar = ControlChars.NullChar EOL = True End If ' We've just encountered a quote sign If c = """"c Then ' Well, are we parsing a string expression now? If ParsingString Then If EOL Then ' End of the line. Finishing the ' current token with an ending quote sign and ' exitting the cycle CurrentToken += c Exit For End If ' Next character is not a quote sign If nextchar <> c Then ' Well, the string expression has just ended here. ParsingString = False ' Adding a closing quote CurrentToken += c Continue For Else ' It's an escape for a quote sign. CurrentToken += c ' Hardcore, but perfectly safe here. ' we simply advance to the next character ' since we only need one quote in a resulting token x += 1 Continue For End If Else ' We're not parsing a string ' Well, we are now. ParsingString = True CurrentToken += c Continue For End If End If ' If we are parsing a string expression ' we simply add the current character to ' our token If ParsingString Then CurrentToken += c 'Else ' Now if we have a prepared token 'If CurrentToken <> "" Then ' ret.Enqueue(CurrentToken) 'End If Else ' Now we'll see what other characters do we have Select Case c Case ControlChars.Cr, ControlChars.Lf, ControlChars.FormFeed, ControlChars.NullChar, _ ControlChars.Tab, ControlChars.VerticalTab, " "c ' doing nothing If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Continue For Case "!"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "|"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "|"c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "&"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "&"c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "^"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "%"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case ","c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If ret.Enqueue(c) Continue For Case "+"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "+"c, "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "-"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "-"c, "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "*"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case "*"c, "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "/"c, "\"c, "="c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If If nextchar <> "="c Then ret.Enqueue(c) Continue For Else ret.Enqueue(c + nextchar) x += 1 Continue For End If Case ">"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case ">"c, "="c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "<"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If Select Case nextchar Case ">"c, "="c, "<"c ret.Enqueue(c + nextchar) x += 1 Continue For Case Else ret.Enqueue(c) Continue For End Select Case "("c, ")"c, "["c, "]"c, "{"c, "}"c If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If ret.Enqueue(c) Continue For Case "0"c To "9"c CurrentToken += c Continue For Case "E"c, "e"c Select Case nextchar Case "+"c, "-"c CurrentToken += (c + nextchar) x += 1 Continue For Case Else CurrentToken += c Continue For End Select Case Else If Char.IsLetterOrDigit(c) OrElse c = "."c OrElse c = "_"c _ OrElse Char.IsPunctuation(c) OrElse Char.IsSymbol(c) Then CurrentToken += c Else 'Throw New SyntaxErrorException(String.Format("Syntax error: unsupported character on position {0}.", x + 1)) End If End Select End If Next If CurrentToken <> "" Then ret.Enqueue(CurrentToken) CurrentToken = "" End If 'ret.Enqueue(CurrentToken) Dim returnArray() As String = ret.ToArray Dim PrevToken As String = "" For x = 0 To returnArray.GetUpperBound(0) Select Case returnArray(x) Case "-", "+", "--", "++", "!", "&", "not" If PrevToken = "" OrElse Operators.IsOperator(PrevToken) OrElse PrevToken = "(" Then returnArray(x) = UNARYMARK + returnArray(x) End If End Select PrevToken = returnArray(x) Next Return returnArray End Function ''' ''' Converts tokenized infix command into a postfix notation (RPN). ''' ''' An array of infix tokens. ''' Array of strink tokens in postfix (RPN) notation. ''' Private Shared Function InfixToPostFix(ByVal Tokens() As String) As String() Dim TokenStack As New Stack(Of String) Dim OutputPostfix As New Queue(Of String) Dim CurrentToken As String For Each CurrentToken In Tokens ' If operand If (Not Functions.IsFunction(CurrentToken)) AndAlso _ (Not Operators.IsOperator(CurrentToken)) AndAlso CurrentToken <> "(" AndAlso CurrentToken <> ")" AndAlso CurrentToken <> "," Then ' Append to the output OutputPostfix.Enqueue(CurrentToken) Continue For End If ' If UnaryPostfix If CurrentToken = "++" OrElse CurrentToken = "--" Then ' Append to the output OutputPostfix.Enqueue(CurrentToken) Continue For End If ' Unary prefix -> to the stack If CurrentToken.StartsWith(UNARYMARK) Then TokenStack.Push(CurrentToken) Continue For End If ' Function name -> to the stack If Functions.IsFunction(CurrentToken) Then TokenStack.Push(CurrentToken) Continue For End If ' Argument separator If CurrentToken = "," Then Do ' Popping until the topmost stack element is "(" If TokenStack.Count > 0 Then If TokenStack.Peek = "(" Then Exit Do OutputPostfix.Enqueue(TokenStack.Pop) Else Throw New SyntaxErrorException("Syntax error: '(' expected. The stack is empty.") End If Loop Continue For End If ' Binary operators If Operators.IsOperator(CurrentToken) AndAlso (Not CurrentToken.StartsWith(UNARYMARK)) Then Dim popped As String If TokenStack.Count > 0 Then popped = TokenStack.Peek If popped = "(" Then TokenStack.Push(CurrentToken) Continue For End If If Not Operators.IsOperator(popped) Then Throw New SyntaxErrorException("Syntax error: expression expected.") End If Dim CurrentPrecidence As Integer = Operators(CurrentToken).Precidence Dim InStackOpPrecidence As Integer = Operators(popped).Precidence If Operators(CurrentToken).RightAssociative Then If InStackOpPrecidence <= CurrentPrecidence Then OutputPostfix.Enqueue(TokenStack.Pop) End If Else If InStackOpPrecidence < CurrentPrecidence Then OutputPostfix.Enqueue(TokenStack.Pop) End If End If End If TokenStack.Push(CurrentToken) Continue For End If ' if "(" -> to the stack If CurrentToken = "(" Then TokenStack.Push(CurrentToken) Continue For End If ' if ")" then If CurrentToken = ")" Then 'Pop operators off the stack and append them to the output, ' until the operator at the top of the stack is a opening bracket. Dim popped As String Do ' Popping until the topmost stack element is "(" If TokenStack.Count > 0 Then popped = TokenStack.Pop If popped = "(" Then Exit Do OutputPostfix.Enqueue(popped) Else Throw New SyntaxErrorException("Syntax error: '(' expected. The stack is empty.") End If Loop If TokenStack.Count <> 0 Then popped = TokenStack.Peek Else Continue For End If If Functions.IsFunction(popped) Then OutputPostfix.Enqueue(TokenStack.Pop) End If Continue For End If Next Do While TokenStack.Count > 0 Dim popped As String = TokenStack.Pop If popped <> "" Then OutputPostfix.Enqueue(popped) Loop Return OutputPostfix.ToArray End Function ''' ''' Evaluates an array postfix (RPN) tokens. ''' ''' An array of postfix (RPN) tokens ''' Evaluation result. ''' Private Shared Function EvaluatePostFix(ByVal Tokens() As String) As ValueClass ' http://scriptasylum.com/tutorials/infix_postfix/algorithms/postfix-evaluation/index.htm ' * Scan the Postfix string from left to right. ' * Initialise an empty stack. ' * If the scannned character is an operand, add it to the stack. ' If the scanned character is an operator, there will be atleast two operands in the stack. ' * If the scanned character is an Operator, then we store the top most element of the stack(topStack) in a variable temp. ' Pop the stack. Now evaluate topStack(Operator)temp. Let the result of this operation be retVal. ' Pop the stack and Push retVal into the stack. ' Repeat this step till all the characters are scanned. ' * After all characters are scanned, we will have only one element in the stack. Return topStack. Dim ValueStack As New Stack(Of ValueClass) Dim CurrentToken As String Dim vc As ValueClass For Each CurrentToken In Tokens ' Allowed tokens are: ' Figures (operands) ' Function names ' Variable identifiers ' Operators ' Operator If Operators.IsOperator(CurrentToken) Then Dim CurrentOp As Op = Operators(CurrentToken) Dim reqArgs As Integer = CurrentOp.OperandsCount Dim Op2 As ValueClass = Nothing If reqArgs = 2 Then Op2 = ValueStack.Pop End If Dim Op1 As ValueClass = ValueStack.Pop ' Invoking operation and pushing the result back into the stack ValueStack.Push(CurrentOp.Evaluate(Op1, Op2)) Continue For End If vc = ParseToken(CurrentToken) If vc Is Nothing Then ' Token was not evaluated, so it is either an operator, an identifier or a function name If Functions.IsFunction(CurrentToken) Then Dim reqArgs As Integer = Functions(CurrentToken).ArgumentsRequired If reqArgs > ValueStack.Count Then Throw New ArgumentNullException("Wrong number of arguments.") Return Nothing End If Dim argOrdinal As Integer Dim args(0 To reqArgs - 1) As ValueClass ' Extracting the necessary number of arguments from the stack For argOrdinal = 0 To reqArgs - 1 args(reqArgs - 1 - argOrdinal) = ValueStack.Pop Next ' Invoking the function call and pushing the result back into the stack ValueStack.Push(Functions(CurrentToken).InvokeVirtualCall(args)) Continue For Else ' it's not a function ' TODO: Qualify identifier If True Then Throw New SyntaxErrorException("Invalid identifier.") End If End If Else ' This is an evaluable operand ValueStack.Push(vc) End If Next If ValueStack.Count <> 1 Then Throw New SyntaxErrorException("Error evaluating the expression.") End If Dim returnValue As ValueClass = ValueStack.Pop Return returnValue End Function ''' ''' Parses a single token and returns ''' ''' A single string token ''' ''' Private Shared Function ParseToken(ByVal Token As String) As ValueClass Dim p As Integer Dim eval As String = "" Token = Token.ToLower Dim str As Boolean = False Dim hex As Boolean = False Dim dot As Boolean = False Dim exp As Boolean = False Dim sgn As Boolean = False 'Dim t As TypeClass._Type Dim returnvalue As ValueClass If Token = "true" Or Token = "false" Then returnvalue = New ValueClass(TypeClass._Type.Bool) returnvalue.Value = CBool(Token) Return returnvalue End If If Token.StartsWith("""") Then str = True Else If Token.ToLower.StartsWith("0x") Then hex = True For p = 2 To Token.Length - 1 Select Case Token(p) Case "0"c To "9"c, "a"c To "f"c eval += Token(p) Case Else Return Nothing End Select Next Else For p = 0 To Token.Length - 1 Select Case Token(p) Case "0"c To "9"c eval += Token(p) Case "."c If dot Then Return Nothing If exp Then Return Nothing dot = True eval += Token(p) Case "e"c If exp Then Return Nothing exp = True eval += Token(p) Case "+"c, "-"c If Not exp Then Return Nothing If sgn Then Return Nothing sgn = True eval += Token(p) Case Else Return Nothing End Select Next End If End If Try If str Then returnvalue = New ValueClass(TypeClass._Type.Text) returnvalue.Value = Token.Substring(1, Token.Length - 2) Return returnvalue End If If hex Then eval = "&h" + eval returnvalue = New ValueClass(TypeClass._Type.Int) returnvalue.Value = CInt(Val(eval)) Return returnvalue End If If dot OrElse exp Then returnvalue = New ValueClass(TypeClass._Type.Float) returnvalue.Value = Val(eval) Return returnvalue End If returnvalue = New ValueClass(TypeClass._Type.Int) returnvalue.Value = CInt(Val(eval)) Return returnvalue Catch ex As Exception Throw New SyntaxErrorException(String.Format("Syntax error: parsing of the token '{0}' has failed.", Token)) End Try End Function ''' ''' Defines standard operators and sets their priorities and associativity ''' Private Shared Sub SetOperators() ' Lesser precedence means greater priority ' Description Priority Associativity Unary or Binary With Operators .RegisterOp("++", 1, False, True) ' Postfix increment 1 Left Unary .RegisterOp("--", 2, False, True) ' Postfix decrement 2 Left Unary .RegisterOp(UNARYMARK + "--", 10, True, True) ' Prefix decrement 10 Right Unary .RegisterOp(UNARYMARK + "++", 11, True, True) ' Prefix increment 11 Right Unary ' Function call has the priority of 15 .RegisterOp(UNARYMARK + "-", 21, True, True) ' Unary minus 21 Right Unary .RegisterOp(UNARYMARK + "+", 22, True, True) ' Unary plus 22 Right Unary .RegisterOp("**", 25, True, False) ' PowerOf 25 Right Binary .RegisterOp(UNARYMARK + "!", 31, True, True) ' Bitwise NOT 31 Right Unary .RegisterOp(UNARYMARK + "not", 31, True, True) ' Bitwise NOT 31 Right Unary .RegisterOp(UNARYMARK + "&", 31, True, True) ' AddressOf 33 Right Unary .RegisterOp("*", 41, False, False) ' Multiplication 41 Left Binary .RegisterOp("/", 42, False, False) ' Division 42 Left Binary .RegisterOp("\", 43, False, False) ' Integer division 43 Left Binary .RegisterOp("%", 44, False, False) ' Modulus 44 Left Binary .RegisterOp("+", 51, False, False) ' Addition (Sum) 51 Left Binary .RegisterOp("-", 52, False, False) ' Subtraction 52 Left Binary .RegisterOp("<<", 61, False, False) ' Left shift 61 Left Binary .RegisterOp(">>", 62, False, False) ' Right shift 62 Left Binary .RegisterOp("<", 70, False, False) ' Less than 70 Left Binary .RegisterOp("<=", 71, False, False) ' Less than or equal to 71 Left Binary .RegisterOp(">", 72, False, False) ' More than 72 Left Binary .RegisterOp(">=", 73, False, False) ' More than or equal to 73 Left Binary .RegisterOp("==", 80, False, False) ' Equal to 80 Left Binary .RegisterOp("!=", 81, False, False) ' Not equal to 81 Left Binary .RegisterOp("<>", 81, False, False) ' Not equal to 81 Left Binary .RegisterOp("&", 90, False, False) ' Bitwise AND 90 Left Binary .RegisterOp("^", 91, False, False) ' Bitwise XOR 91 Left Binary .RegisterOp("|", 92, False, False) ' Bitwise OR 92 Left Binary .RegisterOp("&&", 93, False, False) ' Logical AND 93 Left Binary .RegisterOp("and", 93, False, False) ' Logical AND 93 Left Binary .RegisterOp("||", 94, False, False) ' Logical OR 94 Left Binary .RegisterOp("or", 94, False, False) ' Logical OR 94 Left Binary .RegisterOp("=", 100, True, False) ' Direct assignment 100 Right Binary .RegisterOp("-=", 101, True, False) ' Assignment by difference 101 Right Binary .RegisterOp("+=", 102, True, False) ' Assignment by sum 102 Right Binary .RegisterOp("*=", 103, True, False) ' Assignment by product 103 Right Binary .RegisterOp("/=", 104, True, False) ' Assignment by quotient 104 Right Binary .RegisterOp("\=", 105, True, False) ' Assignment by int. quot. 105 Right Binary .RegisterOp("%=", 106, True, False) ' Assignment by remainder 102 Right Binary End With End Sub ''' ''' Defines standard functions and their number of arguments ''' ''' Private Shared Sub SetBuiltinFunctions() With Functions .RegisterVirtualCall("byte", 1) ' Converts the argument into the Byte data type .RegisterVirtualCall("int", 1) ' Converts the argument into the Int data type .RegisterVirtualCall("bool", 1) ' Converts the argument into the Bool data type .RegisterVirtualCall("text", 1) ' Converts the argument into the Text data type .RegisterVirtualCall("float", 1) ' Converts the argument into the Float data type .RegisterVirtualCall("format", 2) ' Prints the argument to the output .RegisterVirtualCall("sin", 1) ' Returns SIN(x) .RegisterVirtualCall("cos", 1) ' Returns COS(x) .RegisterVirtualCall("tan", 1) ' Returns TAN(x) .RegisterVirtualCall("sqrt", 1) ' Returns SQRT(x) .RegisterVirtualCall("abs", 1) ' Returns ABS(x) .RegisterVirtualCall("acos", 1) ' Return ACOS(x) .RegisterVirtualCall("asin", 1) ' Return ASIN(x) .RegisterVirtualCall("atan", 1) ' Returns ATAN(x) .RegisterVirtualCall("exp", 1) ' Returns EXP(x) .RegisterVirtualCall("ln", 1) ' Returns LN(x) (natural) .RegisterVirtualCall("log", 2) ' Returns LOG(x, base) .RegisterVirtualCall("lg", 1) ' Returns LOG(x, 10) .RegisterVirtualCall("max", 2) ' Returns the greatest of two arguments .RegisterVirtualCall("min", 2) ' Returns the smallest of two arguments .RegisterVirtualCall("round", 2) ' Rounds the given argument to the desired precision .RegisterVirtualCall("sign", 1) ' Returns -1 if the argument is negative, 1 if positive and 0 if 0 .RegisterVirtualCall("fix", 1) ' Returns an integer part of a fractional number .RegisterVirtualCall("left", 2) ' Returns the left part of the string .RegisterVirtualCall("right", 2) ' Returns the right part of the string .RegisterVirtualCall("len", 1) ' Returns the length of the text .RegisterVirtualCall("substr", 3) ' Returns the substring of the text .RegisterVirtualCall("seek", 2) ' Searches through the string and returns the first pos found .RegisterVirtualCall("ucase", 1) ' Returns the given string in uppercase .RegisterVirtualCall("lcase", 1) ' Returns the given string in lowercase .RegisterVirtualCall("trim", 1) ' Trims leading and trailing spaces .RegisterVirtualCall("chr", 1) ' Returns a character with the given charcode .RegisterVirtualCall("chrw", 1) ' Returns a wide character with the given charcode .RegisterVirtualCall("asc", 1) ' Returns an ascii code of the given character .RegisterVirtualCall("ascw", 1) ' Returns a long ascii code of the given character .RegisterVirtualCall("replace", 5) ' Replaces a substring of the text with a given sample End With End Sub ''' ''' Class that stores value and its data type. ''' ''' Public Class ValueClass Private m_type As TypeClass._Type Public ReadOnly Property MyType() As TypeClass._Type Get Return m_type End Get End Property Public Sub New(ByVal [Type] As TypeClass._Type) m_type = Type End Sub Public Value As Object End Class ''' ''' Represents a variable. Inherits from ValueClass. Adds Name property. ''' ''' Public Class VariableClass Inherits ValueClass Private m_name As String Public ReadOnly Property Name() As String Get Return m_name End Get End Property Public Sub New(ByVal Name As String, ByVal Type As TypeClass._Type, Optional ByVal Value As Object = Nothing) MyBase.New(Type) m_name = Name MyBase.Value = Value End Sub End Class Public MustInherit Class TypeClass Public Enum _Type Int Float Text [Byte] Bool Pointer End Enum Public MustOverride ReadOnly Property [Type]() As _Type ' Operators must be defined for each data type End Class ''' ''' Represents an operator. It defines the token (max 2 chars), the precidence, ''' the number of operands (unary or binary), right or left associativity and also ''' a function delegate to call in order to evaluate the operation. ''' ''' Private Class Op Private _optoken As String Private _precidence As Integer Private _operands As Integer Private _eprovider As EvaluateCallback Private _rightassociativity As Boolean Public Sub New(ByVal OpToken As String, ByVal Precidence As Integer, ByVal RightAssociative As Boolean, ByVal unary As Boolean, Optional ByVal EvalProvider As EvaluateCallback = Nothing) _optoken = OpToken _precidence = Precidence _rightassociativity = RightAssociative If unary Then _operands = 1 Else _operands = 2 _eprovider = EvalProvider End Sub Public Sub SetEvaluatorCallback(ByVal Provider As EvaluateCallback) _eprovider = Provider End Sub Public ReadOnly Property Precidence() As Integer Get Return _precidence End Get End Property Public ReadOnly Property RightAssociative() As Boolean Get Return _rightassociativity End Get End Property Public ReadOnly Property OperandsCount() As Integer Get Return _operands End Get End Property Public ReadOnly Property [Operator]() As String Get Return _optoken End Get End Property Public Function Evaluate(ByVal Op1 As ValueClass, Optional ByVal Op2 As ValueClass = Nothing) As ValueClass If _eprovider Is Nothing Then Throw New Exception("No evaluator set.") Return Nothing End If Return _eprovider.Invoke(Op1, Op2) End Function End Class ''' ''' Represents a collevtion of registered operators. ''' ''' Private Class OperatorsCol Private m_OpCol As New Collections.Generic.Dictionary(Of String, Op) Public Function IsOperator(ByVal Token As String) As Boolean Return m_OpCol.Keys.Contains(Token) End Function Public Function IsUnary(ByVal Token As String) As Boolean If IsOperator(Token) Then If m_OpCol(Token).OperandsCount = 1 Then Return True Else Return False End If End Function Public Sub RegisterOp(ByVal Token As String, ByVal Precidence As Integer, ByVal RightAssociative As Boolean, ByVal Unary As Boolean, Optional ByVal EvaluationFunc As EvaluateCallback = Nothing) Dim NewOp As New Op(Token, Precidence, RightAssociative, Unary, EvaluationFunc) m_OpCol.Add(Token, NewOp) End Sub Default Public ReadOnly Property Op(ByVal Token As String) As Op Get If m_OpCol.Keys.Contains(Token) Then Return m_OpCol(Token) Else Return Nothing End Get End Property End Class ''' ''' Represents a virtual function. It defines the function name, the required number of arguments, ''' and a virtual call delegate to invoke in order to evaluate the function. ''' ''' Private Class Func Private m_Funcname As String Private m_ArgNumber As Integer Private m_VirtualCall As VirtualFunctionCall Public Sub SetVirtualCall(ByVal FuncDelegate As VirtualFunctionCall) m_VirtualCall = FuncDelegate End Sub Public Sub New(ByVal FunctionName As String, ByVal ArgumentsNumber As Integer, Optional ByVal VirtualCall As VirtualFunctionCall = Nothing) m_Funcname = FunctionName m_ArgNumber = ArgumentsNumber m_VirtualCall = VirtualCall End Sub Public Function InvokeVirtualCall(ByVal args() As ValueClass) As ValueClass If IsNothing(m_VirtualCall) Then Throw New Exception("No function assigned for this virtual call.") Return Nothing End If Return m_VirtualCall.Invoke(args) End Function Public ReadOnly Property ArgumentsRequired() As Integer Get Return m_ArgNumber End Get End Property End Class ''' ''' Represents a virtual functions table. It holds all callable built-in functions. ''' ''' Private Class VirtualFunctionsTable Private m_FuncsCol As New Collections.Generic.Dictionary(Of String, Func) Public Function IsFunction(ByVal Token As String) As Boolean Return m_FuncsCol.Keys.Contains(Token) End Function Public Sub RegisterVirtualCall(ByVal Token As String, ByVal ArgsNumber As Integer, Optional ByVal VirtualCallDelegate As VirtualFunctionCall = Nothing) Dim NewFunc As New Func(Token, ArgsNumber, VirtualCallDelegate) m_FuncsCol.Add(Token, NewFunc) End Sub Default Public ReadOnly Property Func(ByVal Token As String) As Func Get If m_FuncsCol.Keys.Contains(Token) Then Return m_FuncsCol(Token) Else Return Nothing End Get End Property End Class #Region "Operators Definitions" ' x++ Private Shared Function PostfixIncrement(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(Op1.MyType) Try Select Case Op1.MyType Case TypeClass._Type.Int result.Value = CInt(Op1.Value) + 1 Return result Case TypeClass._Type.Byte result.Value = CByte(Op1.Value) + CByte(1) Return result Case Else Throw New NotSupportedException("Postfix increment operation is not defined for this data type.") End Select Catch ex As NotSupportedException Throw New NotSupportedException(ex.Message, ex) Catch ex As Exception Throw New OverflowException("Postfix increment operation resulted in overflow.") End Try End Function ' x-- Private Shared Function PostfixDecrement(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(Op1.MyType) Try Select Case Op1.MyType Case TypeClass._Type.Int result.Value = CInt(Op1.Value) - 1 Return result Case TypeClass._Type.Byte result.Value = CByte(Op1.Value) - CByte(1) Return result Case Else Throw New NotSupportedException("Postfix decrement operation is not defined for this data type.") End Select Catch ex As NotSupportedException Throw New NotSupportedException(ex.Message, ex) Catch ex As Exception Throw New OverflowException("Postfix decrement operation resulted in overflow.") End Try End Function ' ++x Private Shared Function PrefixIncrement(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass ' Op1 is changed (since it has been passes by reference) Try Select Case Op1.MyType Case TypeClass._Type.Int Op1.Value = CInt(Op1.Value) + 1 Return Op1 Case TypeClass._Type.Byte Op1.Value = CByte(Op1.Value) + CByte(1) Return Op1 Case Else Throw New NotSupportedException("Prefix increment operation is not defined for this data type.") End Select Catch ex As NotSupportedException Throw New NotSupportedException(ex.Message, ex) Catch ex As Exception Throw New OverflowException("Prefix increment operation resulted in overflow.") End Try End Function ' --x Private Shared Function PrefixDecrement(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass ' Op1 is changed (since it has been passes by reference) Try Select Case Op1.MyType Case TypeClass._Type.Int Op1.Value = CInt(Op1.Value) - 1 Return Op1 Case TypeClass._Type.Byte Op1.Value = CByte(Op1.Value) - CByte(1) Return Op1 Case Else Throw New NotSupportedException("Prefix decrement operation is not defined for this data type.") End Select Catch ex As NotSupportedException Throw New NotSupportedException(ex.Message, ex) Catch ex As Exception Throw New OverflowException("Prefix decrement operation resulted in overflow.") End Try End Function ' -x Private Shared Function UnaryMinus(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass ' Op1 is changed since it's been passed by reference Try Select Case Op1.MyType Case TypeClass._Type.Int Op1.Value = -CInt(Op1.Value) Return Op1 Case TypeClass._Type.Float Op1.Value = -CDbl(Op1.Value) Return Op1 Case Else Throw New NotSupportedException("Unary minus operation is not defined for this data type.") End Select Catch ex As NotSupportedException Throw New NotSupportedException(ex.Message, ex) Catch ex As Exception Throw New OverflowException("Unary minus operation resulted in overflow.") End Try End Function ' +x Private Shared Function UnaryPlus(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass ' simply return Op1 Try Select Case Op1.MyType Case TypeClass._Type.Int, TypeClass._Type.Float, TypeClass._Type.Byte Return Op1 Case Else Throw New NotSupportedException("Unary plus operation is not defined for this data type.") End Select Catch ex As NotSupportedException Throw New NotSupportedException(ex.Message, ex) Catch ex As Exception Throw New OverflowException("Unary plus operation resulted in overflow.") End Try End Function ' x ** y Private Shared Function PowerOf(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass If Op1.MyType = TypeClass._Type.Bool OrElse Op1.MyType = TypeClass._Type.Text OrElse _ Op2.MyType = TypeClass._Type.Bool OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException(String.Format("PowerOf operation is not defined for this data type.", Op1.MyType.ToString)) End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = CDbl(Op1.Value) ^ CDbl(Op2.Value) Return result Catch ex As Exception Throw New InvalidCastException("Illegal function call.", ex) End Try End Function ' !x (NOT x) Private Shared Function BitwiseNot(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(Op1.MyType) Select Case Op1.MyType Case TypeClass._Type.Byte result.Value = Not CByte(Op1.Value) Case TypeClass._Type.Int result.Value = Not CInt(Op1.Value) Case TypeClass._Type.Float result.Value = Not CInt(Op1.Value) Case TypeClass._Type.Bool result.Value = Not CBool(Op1.Value) Case Else Throw New NotSupportedException("Bitwise NOT operation is not defined for this data type.") End Select Return result End Function ' &x Private Shared Function Address_Of(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Pointer) Try Dim gc As System.Runtime.InteropServices.GCHandle = System.Runtime.InteropServices.GCHandle.Alloc(Op1.Value, Runtime.InteropServices.GCHandleType.Pinned) result.Value = CInt(gc.AddrOfPinnedObject.ToInt32) gc.Free() Return result Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Function ' x * y Private Shared Function Multiply(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass If Op1.MyType = TypeClass._Type.Text OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Multiplication operation is not supported for this data type.") End If Dim t As TypeClass._Type = TypeClass._Type.Int If Op1.MyType = TypeClass._Type.Float OrElse Op2.MyType = TypeClass._Type.Float Then t = TypeClass._Type.Float End If Dim result As New ValueClass(t) Try Select Case t Case TypeClass._Type.Int result.Value = CInt(Op1.Value) * CInt(Op2.Value) Case TypeClass._Type.Float result.Value = CDbl(Op1.Value) * CDbl(Op2.Value) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x / y Private Shared Function Divide(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Float) If Op1.MyType = TypeClass._Type.Text OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Division operation is not supported for this data type.") End If If CDbl(Op2.Value) = 0 Then Throw New DivideByZeroException("Division by zero.") End If result.Value = CDbl(Op1.Value) / CDbl(Op2.Value) Return result End Function ' x \ y Private Shared Function IntegerDivide(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Int) If Op1.MyType = TypeClass._Type.Text OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Integer division operation is not supported for this data type.") End If If CDbl(Op2.Value) = 0 Then Throw New DivideByZeroException("Integer division by zero.") End If result.Value = CInt(Op1.Value) \ CInt(Op2.Value) Return result End Function ' x % y Private Shared Function Modulus(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Float) If Op1.MyType = TypeClass._Type.Text OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Modulus operation is not supported for this data type.") End If If CDbl(Op2.Value) = 0 Then Throw New DivideByZeroException("Division by zero.") End If result.Value = CDbl(Op1.Value) Mod CDbl(Op2.Value) Return result End Function ' x + y Private Shared Function Addition(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim t As TypeClass._Type Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Byte t = TypeClass._Type.Byte Case TypeClass._Type.Int, TypeClass._Type.Pointer, TypeClass._Type.Bool t = TypeClass._Type.Int Case TypeClass._Type.Float t = TypeClass._Type.Float Case TypeClass._Type.Text t = TypeClass._Type.Text End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Byte t = TypeClass._Type.Byte Case TypeClass._Type.Int, TypeClass._Type.Pointer, TypeClass._Type.Bool t = TypeClass._Type.Int Case TypeClass._Type.Float t = TypeClass._Type.Float Case TypeClass._Type.Text t = TypeClass._Type.Text End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte, TypeClass._Type.Int, TypeClass._Type.Pointer t = TypeClass._Type.Int Case TypeClass._Type.Float t = TypeClass._Type.Float Case TypeClass._Type.Text t = TypeClass._Type.Text End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text t = TypeClass._Type.Text Case Else t = TypeClass._Type.Float End Select Case TypeClass._Type.Text t = TypeClass._Type.Text End Select Dim result As New ValueClass(t) Try Select Case t Case TypeClass._Type.Bool, TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CInt(Op1.Value) + CInt(Op2.Value) Case TypeClass._Type.Byte result.Value = CByte(Op1.Value) + CByte(Op2.Value) Case TypeClass._Type.Float result.Value = CDbl(Op1.Value) + CDbl(Op2.Value) Case TypeClass._Type.Text result.Value = CStr(Op1.Value) + CStr(Op2.Value) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x - y Private Shared Function Subtraction(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim t As TypeClass._Type Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Byte t = TypeClass._Type.Byte Case TypeClass._Type.Int, TypeClass._Type.Pointer, TypeClass._Type.Bool t = TypeClass._Type.Int Case TypeClass._Type.Float t = TypeClass._Type.Float Case TypeClass._Type.Text Throw New NotSupportedException("Subtraction operation is not supported by this data type.") End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Byte t = TypeClass._Type.Byte Case TypeClass._Type.Int, TypeClass._Type.Pointer, TypeClass._Type.Bool t = TypeClass._Type.Int Case TypeClass._Type.Float t = TypeClass._Type.Float Case TypeClass._Type.Text Throw New NotSupportedException("Subtraction operation is not supported by this data type.") End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte, TypeClass._Type.Int, TypeClass._Type.Pointer t = TypeClass._Type.Int Case TypeClass._Type.Float t = TypeClass._Type.Float Case TypeClass._Type.Text Throw New NotSupportedException("Subtraction operation is not supported by this data type.") End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text Throw New NotSupportedException("Subtraction operation is not supported by this data type.") Case Else t = TypeClass._Type.Float End Select Case TypeClass._Type.Text Throw New NotSupportedException("Subtraction operation is not supported by this data type.") End Select Dim result As New ValueClass(t) Try Select Case t Case TypeClass._Type.Byte result.Value = CByte(CByte(Op1.Value) - CByte(Op2.Value)) Case TypeClass._Type.Int result.Value = CInt(Op1.Value) - CInt(Op2.Value) Case TypeClass._Type.Float result.Value = CDbl(Op1.Value) - CDbl(Op2.Value) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x << y Private Shared Function LeftShift(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass If Op1.MyType = TypeClass._Type.Text OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Left shift operation is not supported by this data type.") End If Dim result As New ValueClass(TypeClass._Type.Int) Try result.Value = CInt(Op1.Value) << CInt(Op2.Value) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x >> y Private Shared Function RightShift(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass If Op1.MyType = TypeClass._Type.Text OrElse Op2.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Right shift operation is not supported by this data type.") End If Dim result As New ValueClass(TypeClass._Type.Int) Try result.Value = CInt(Op1.Value) >> CInt(Op2.Value) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x < y Private Shared Function LessThan(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) Try Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Bool result.Value = CBool(CBool(Op1.Value) < CBool(Op2.Value)) Case TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) < CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) < CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) < CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) < CStr(Op2.Value)) End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) < CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) < CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) < CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) < CStr(Op2.Value)) End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) < CStr(Op2.Value)) Case Else result.Value = CBool(CDbl(Op1.Value) < CDbl(Op2.Value)) End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) < CStr(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) < CDbl(Op2.Value)) Case Else result.Value = CBool(CInt(Op1.Value) < CInt(Op2.Value)) End Select Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) < CStr(Op2.Value)) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x <= y Private Shared Function LessThanOrEqual(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) Try Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Bool result.Value = CBool(CBool(Op1.Value) <= CBool(Op2.Value)) Case TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) <= CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) <= CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) <= CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <= CStr(Op2.Value)) End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) <= CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) <= CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) <= CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <= CStr(Op2.Value)) End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <= CStr(Op2.Value)) Case Else result.Value = CBool(CDbl(Op1.Value) <= CDbl(Op2.Value)) End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <= CStr(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) <= CDbl(Op2.Value)) Case Else result.Value = CBool(CInt(Op1.Value) <= CInt(Op2.Value)) End Select Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <= CStr(Op2.Value)) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x > y Private Shared Function GreaterThan(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) Try Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Bool result.Value = CBool(CBool(Op1.Value) > CBool(Op2.Value)) Case TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) > CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) > CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) > CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) > CStr(Op2.Value)) End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) > CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) > CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) > CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) > CStr(Op2.Value)) End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) > CStr(Op2.Value)) Case Else result.Value = CBool(CDbl(Op1.Value) > CDbl(Op2.Value)) End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) > CStr(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) > CDbl(Op2.Value)) Case Else result.Value = CBool(CInt(Op1.Value) > CInt(Op2.Value)) End Select Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) > CStr(Op2.Value)) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x >= y Private Shared Function GreaterThanOrEqual(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) Try Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Bool result.Value = CBool(CBool(Op1.Value) >= CBool(Op2.Value)) Case TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) >= CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) >= CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) >= CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) >= CStr(Op2.Value)) End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) >= CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) >= CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) >= CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) >= CStr(Op2.Value)) End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) >= CStr(Op2.Value)) Case Else result.Value = CBool(CDbl(Op1.Value) >= CDbl(Op2.Value)) End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) >= CStr(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) >= CDbl(Op2.Value)) Case Else result.Value = CBool(CInt(Op1.Value) >= CInt(Op2.Value)) End Select Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) >= CStr(Op2.Value)) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x == y (equality, not assignment) Private Shared Function Equality(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) Try Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Bool result.Value = CBool(CBool(Op1.Value) = CBool(Op2.Value)) Case TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) = CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) = CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) = CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) = CStr(Op2.Value)) End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) = CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) = CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) = CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) = CStr(Op2.Value)) End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) = CStr(Op2.Value)) Case Else result.Value = CBool(CDbl(Op1.Value) = CDbl(Op2.Value)) End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) = CStr(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) = CDbl(Op2.Value)) Case Else result.Value = CBool(CInt(Op1.Value) = CInt(Op2.Value)) End Select Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) = CStr(Op2.Value)) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x != y Private Shared Function NotEqual(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) Try Select Case Op1.MyType Case TypeClass._Type.Bool Select Case Op2.MyType Case TypeClass._Type.Bool result.Value = CBool(CBool(Op1.Value) <> CBool(Op2.Value)) Case TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) <> CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) <> CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) <> CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <> CStr(Op2.Value)) End Select Case TypeClass._Type.Byte Select Case Op2.MyType Case TypeClass._Type.Bool, TypeClass._Type.Byte result.Value = CBool(CByte(Op1.Value) <> CByte(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) <> CDbl(Op2.Value)) Case TypeClass._Type.Int, TypeClass._Type.Pointer result.Value = CBool(CInt(Op1.Value) <> CInt(Op2.Value)) Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <> CStr(Op2.Value)) End Select Case TypeClass._Type.Float Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <> CStr(Op2.Value)) Case Else result.Value = CBool(CDbl(Op1.Value) <> CDbl(Op2.Value)) End Select Case TypeClass._Type.Int, TypeClass._Type.Pointer Select Case Op2.MyType Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <> CStr(Op2.Value)) Case TypeClass._Type.Float result.Value = CBool(CDbl(Op1.Value) <> CDbl(Op2.Value)) Case Else result.Value = CBool(CInt(Op1.Value) <> CInt(Op2.Value)) End Select Case TypeClass._Type.Text result.Value = CBool(CStr(Op1.Value) <> CStr(Op2.Value)) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x & y Private Shared Function BitwiseAND(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Int) If Op1.MyType = TypeClass._Type.Text OrElse Op1.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Bitwise AND operation is not defined for this data type.") End If Try result.Value = CInt(CInt(Op1.Value) And CInt(Op2.Value)) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x ^ y (Bitwise XOR) Private Shared Function BitwiseXOR(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Int) If Op1.MyType = TypeClass._Type.Text OrElse Op1.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Bitwise XOR operation is not defined for this data type.") End If Try result.Value = CInt(CInt(Op1.Value) Xor CInt(Op2.Value)) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x | y Private Shared Function BitwiseOR(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Int) If Op1.MyType = TypeClass._Type.Text OrElse Op1.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Bitwise OR operation is not defined for this data type.") End If Try result.Value = CInt(CInt(Op1.Value) Or CInt(Op2.Value)) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x && y Private Shared Function LogicalAND(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) If Op1.MyType = TypeClass._Type.Text OrElse Op1.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Logical AND operation is not defined for this data type.") End If Try result.Value = CBool(CBool(Op1.Value) AndAlso CBool(Op2.Value)) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x || y Private Shared Function LogicalOR(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(TypeClass._Type.Bool) If Op1.MyType = TypeClass._Type.Text OrElse Op1.MyType = TypeClass._Type.Text Then Throw New NotSupportedException("Logical OR operation is not defined for this data type.") End If Try result.Value = CBool(CBool(Op1.Value) OrElse CBool(Op2.Value)) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return result End Function ' x = y (Assignment) Private Shared Function Assignment(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Dim result As New ValueClass(Op1.MyType) Try Select Case Op1.MyType Case TypeClass._Type.Bool Op1.Value = CBool(Op2.Value) Case TypeClass._Type.Byte Op1.Value = CByte(Op2.Value) Case TypeClass._Type.Float Op1.Value = CDbl(Op2.Value) Case TypeClass._Type.Int, TypeClass._Type.Pointer Op1.Value = CInt(Op2.Value) Case TypeClass._Type.Text Op1.Value = CStr(Op2.Value) End Select Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function ' x -= y Private Shared Function AssignmentByDifference(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Try Op1.Value = Subtraction(Op1, Op2) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function ' x += y Private Shared Function AssignmentBySum(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Try Op1.Value = Addition(Op1, Op2) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function ' x *= y Private Shared Function AssignmentByProduct(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Try Op1.Value = Multiply(Op1, Op2) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function ' x /= y Private Shared Function AssignmentByQuotient(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Try Op1.Value = Divide(Op1, Op2) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function ' x \= y Private Shared Function AssignmentByIntegerQuotient(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Try Op1.Value = IntegerDivide(Op1, Op2) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function ' x %= y Private Shared Function AssignmentByModulus(ByRef Op1 As ValueClass, ByRef Op2 As ValueClass) As ValueClass Try Op1.Value = Modulus(Op1, Op2) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try Return Nothing End Function #End Region #Region "Function definitions" Private Shared Function _Byte(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Byte) result.Value = CByte(args(0).Value) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Int(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = CInt(args(0).Value) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Bool(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Bool) result.Value = CBool(args(0).Value) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Text(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = CStr(args(0).Value) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Float(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = CDbl(args(0).Value) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Format(ByVal args() As ValueClass) As ValueClass If args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If Dim result As New ValueClass(TypeClass._Type.Text) Try result.Value = Format(CStr(args(0).Value), CStr(args(1).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Sin(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Sin(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Cos(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Cos(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Tan(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Tan(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Sqrt(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Sqrt(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Abs(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Dim result As ValueClass = Nothing Try Select Case args(0).MyType Case TypeClass._Type.Byte, TypeClass._Type.Int, TypeClass._Type.Pointer result = New ValueClass(TypeClass._Type.Int) result.Value = Math.Abs(CInt(args(0).Value)) Return result Case Else result = New ValueClass(TypeClass._Type.Float) result.Value = Math.Abs(CDbl(args(0).Value)) Return result End Select Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Acos(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Acos(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Asin(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Asin(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Atan(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Atan(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Exp(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Exp(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Ln(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Log(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Log(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Log(CDbl(args(0).Value), CDbl(args(1).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Lg(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Log10(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Max(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try If CDbl(args(0).Value) >= CDbl(args(1).Value) Then Return args(0) Else Return args(1) End If Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Min(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try If CDbl(args(0).Value) < CDbl(args(1).Value) Then Return args(0) Else Return args(1) End If Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Round(ByVal args() As ValueClass) As ValueClass If args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If If args(1).MyType = TypeClass._Type.Bool OrElse args(1).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Float) result.Value = Math.Round(CDbl(args(0).Value), CInt(args(1).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Sign(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = Math.Sign(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Fix(ByVal args() As ValueClass) As ValueClass If Not IsNothing(args) AndAlso args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = CInt(CDbl(args(0).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Left(ByVal args() As ValueClass) As ValueClass If args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(1).MyType = TypeClass._Type.Bool OrElse args(1).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = Left(CStr(args(0).Value), CInt(args(1).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Right(ByVal args() As ValueClass) As ValueClass If args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(1).MyType = TypeClass._Type.Bool OrElse args(1).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = Right(CStr(args(0).Value), CInt(args(1).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Len(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = CStr(args(0).Value).Length Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Substr(ByVal args() As ValueClass) As ValueClass If args.Length <> 3 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(1).MyType = TypeClass._Type.Bool OrElse args(1).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If If args(2).MyType = TypeClass._Type.Bool OrElse args(2).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = Mid(CStr(args(0).Value), CInt(args(1).Value), CInt(args(2).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Seek(ByVal args() As ValueClass) As ValueClass If args.Length <> 2 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = InStr(CStr(args(0).Value), CStr(args(1).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _UCase(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = CStr(args(0).Value).ToUpper Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _LCase(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = CStr(args(0).Value).ToLower Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Trim(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = CStr(args(0).Value).Trim Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Chr(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = Chr(CInt(args(0).Value)).ToString Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _ChrW(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(0).MyType = TypeClass._Type.Bool OrElse args(0).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = ChrW(CInt(args(0).Value)).ToString Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Asc(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = Asc(CStr(args(0).Value).Substring(0, 1)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _AscW(ByVal args() As ValueClass) As ValueClass If args.Length <> 1 Then Throw New ArgumentException("Wrong number of arguments.") End If Try Dim result As New ValueClass(TypeClass._Type.Int) result.Value = AscW(CStr(args(0).Value).Substring(0, 1)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function Private Shared Function _Replace(ByVal args() As ValueClass) As ValueClass If args.Length <> 5 Then Throw New ArgumentException("Wrong number of arguments.") End If If args(3).MyType = TypeClass._Type.Bool OrElse args(4).MyType = TypeClass._Type.Bool OrElse _ args(3).MyType = TypeClass._Type.Text OrElse args(4).MyType = TypeClass._Type.Text Then Throw New ArgumentException("Type mismatch.") End If Try Dim result As New ValueClass(TypeClass._Type.Text) result.Value = Replace(CStr(args(0).Value), CStr(args(1).Value), CStr(args(2).Value), CInt(args(3).Value), CInt(args(4).Value)) Return result Catch ex As Exception Throw New ArgumentException(ex.Message, ex) End Try End Function #End Region End Class