functionparser

Imports System.Windows.Forms
Imports System.ComponentModel

Namespace Common.Util

    <DefaultEvent("OnExecuting")>
    Public Class FunctionComponent

        Public Property Functions As New List(Of FunctionItem)
        Public Property Source As String = ""
        Public Property Errors As New List(Of String)

        Public Event OnExecuting(e As FunctionItem)

        Public Sub Execute(s As String)
            If s.EndsWith(";") AndAlso Not s = "" Then
                Source += s & vbCrLf

                Dim item As New FunctionItem
                item.Name = s.Split("(")(0)

                If item.Name.Contains(".") Then
                    item.Class = item.Name.Split(".")(0)
                    item.Name = item.Name.Split(".")(1)
                End If

                Dim argumentlist As String = s.Middle("(", ")")

                If argumentlist.Contains(",") Then
                    Dim args As String() = argumentlist.Split(",")

                    For Each l In args
                        Dim arg As New Argument
                        arg.Value = l
                        arg.Type = ParseType(arg)

                        item.Arguments.Add(arg)
                    Next
                Else
                    Dim arg As New Argument
                    arg.Value = argumentlist
                    arg.Type = ParseType(arg)

                    item.Arguments.Add(arg)
                End If

                Functions.Add(item)

                RaiseEvent OnExecuting(item)
            Else
                MessageBox.Show("Cannot executing command, please check if you leave the ;")
            End If
        End Sub

        Public Function ArgumentError(arguments As List(Of Argument), argumentcount As Integer, funcname As String) As Boolean
            ' If arguments.Count < argumentcount Then
            ' Errors.Add("Es wurden in der Funktion '" & funcname & "' zu viele Argumente angegeben!")
            ' Return True
            '   ElseIf arguments.Count > argumentcount Then
            'Errors.Add("Es wurden in der Funktion '" & funcname & "' zu wenige Argumente angegeben!")
            'Return True
            '  Else
            ' Return False
            ' End If
            If arguments.Count = argumentcount Then
                Return True
            Else
                Errors.Add("Es wurden in der Funktion '" & funcname & "' zu wenige oder zu viele Argumente angegeben!")
                Return False
            End If
        End Function

        Public Function Replace(s As String) As String
            Return s.Replace("%Desktop%", Environment.GetFolderPath(Environment.SpecialFolder.Desktop)) _
                .Replace("%Documents%", Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)) _
            .Replace("%ProgrammFiles%", Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles)) _
            .Replace("%ProgrammFiles86%", Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86)) _
            .Replace("%nl%", Environment.NewLine) _
            .Replace("%tab%", vbTab)
        End Function

        Public Sub ExecuteFile(file As String)
            For Each line As String In IO.File.ReadAllLines(file)
                Execute(line)
            Next
        End Sub

        Public Sub ExecuteSource(source As RichTextBox)
            For Each line As String In source.Lines
                Execute(line)
            Next
        End Sub

        Private Function ParseType(s As Argument) As ArgumentType
            If s.Value.IsInteger Then
                Return ArgumentType.Integer
            ElseIf s.Value.IsBoolean Then
                Return ArgumentType.Boolean
            ElseIf isstring(s) Then
                If s.Value.IsValidUrl() Then
                    Return ArgumentType.URLString
                ElseIf s.Value.isValidMail Then
                    Return ArgumentType.MailString
                Else
                    Return ArgumentType.String
                End If
            Else
                Return ArgumentType.String
            End If
        End Function
        Private Function isstring(s As Argument) As String
            If s.Value.StartsWith("'") AndAlso s.Value.EndsWith("'") Then
                Try
                    s.Value = s.Value.Remove(0, 1)
                    s.Value = s.Value.Remove(s.Value.Length - 1, 1)
                Catch
                End Try
                Return True
            Else
                Return False
            End If
        End Function

        Public Class FunctionItem

            Public Property [Class] As String
            Public Property Name As String
            Public Property Arguments As New List(Of Argument)

        End Class
        Public Class Argument
            Public Property Value As String
            Public Property Type As ArgumentType
        End Class
        Public Enum ArgumentType
            [String] = 0
            [Integer] = 1
            [Boolean] = 2
            [URLString] = 3
            [MailString] = 4
        End Enum

    End Class

End Namespace