Public Enum BlockState
    uninitialised
    complete
    inerror
End Enum
 
Public Class BlockName
    Private _name As String
    Private _nummer As Integer
    Private _position As Integer
    Private _option As Integer
 
    Private _unterblocks As New List(Of UnterBlock)
    Private _blockNames As New List(Of BlockName)
 
    Private _state As BlockState = BlockState.uninitialised
    Private _errorMessages As New List(Of String)
 
    Public Property Name() As String
        Get
            Return _name
        End Get
        Set(ByVal value As String)
            _name = value
        End Set
    End Property
 
    Public Property Nummer() As Integer
        Get
            Return _nummer
        End Get
        Set(ByVal value As Integer)
            _nummer = value
        End Set
    End Property
 
    Public Property Position() As Integer
        Get
            Return _position
        End Get
        Set(ByVal value As Integer)
            _position = value
        End Set
    End Property
 
    Public Property [Option]() As Integer
        Get
            Return _option
        End Get
        Set(ByVal value As Integer)
            _option = value
        End Set
    End Property
 
    Public ReadOnly Property BlockNames() As List(Of BlockName)
        Get
            Return _blockNames
        End Get
    End Property
 
    Public ReadOnly Property UnterBlocks() As List(Of UnterBlock)
        Get
            Return _unterblocks
        End Get
    End Property
 
    Public ReadOnly Property State() As BlockState
        Get
            Return _state
        End Get
    End Property
 
    <Xml.Serialization.XmlIgnoreAttribute()> _
    Public ReadOnly Property ErrorMessages() As List(Of String)
        Get
            Return _errorMessages
        End Get
    End Property
 
    Public Sub New()
 
    End Sub
 
    Public Sub New(ByVal name As String, ByVal nummer As String, ByVal position _
      As String, ByVal [option] As String)
        _name = name
        _nummer = nummer
        _position = position
        _option = [option]
        _state = BlockState.complete
    End Sub
 
    Public Sub New(ByVal data As String)
        Debug.WriteLine("BlocknameData:" & data)
        If data.StartsWith("{") AndAlso data.EndsWith("}") Then
            Dim kgrbn As New KeyGroupReader(data.Substring(1, data.Length - 2))
 
            Dim val = kgrbn.GetKeywordParameter("Name", Nothing)
            _name = val
            val = kgrbn.GetKeywordParameter("Nummer", Nothing)
            _nummer = val
            val = kgrbn.GetKeywordParameter("Position", Nothing)
            _position = val
            val = kgrbn.GetKeywordParameter("Option", Nothing)
            _option = val
 
            Dim subBlockData As String
            Do
                subBlockData = kgrbn.GetKeywordParameter("?", Nothing)
                If subBlockData <> String.Empty Then
                    Dim lkwd As String = kgrbn.LastkeyWord
                    Select Case lkwd
                        Case "Unterblock"
                            Debug.WriteLine("subBlockData: " & subBlockData)
                            Dim ub As New UnterBlock(subBlockData)
                            If ub.State = BlockState.complete Then
                                _unterblocks.Add(ub)
                            Else
                                _errorMessages.Add("Invalid UnterBlock")
                                _state = BlockState.inerror
                            End If
                        Case "Blockname"
                            Debug.WriteLine("BlocknameData: " & subBlockData)
 
                            Dim bn As New BlockName(subBlockData)
                            If bn.State = BlockState.complete Then
                                _blockNames.Add(bn)
                            Else
                                _errorMessages.AddRange( _
                                  bn.ErrorMessages.ToArray())
                                _state = BlockState.inerror
                            End If
                    End Select
                End If
            Loop While subBlockData <> String.Empty AndAlso _state = _
              BlockState.uninitialised
            _state = BlockState.complete
        Else
            _state = BlockState.inerror
            _errorMessages.Add("Invalid input string")
        End If
    End Sub
 
    Public Overrides Function ToString() As String
 
        If _state = BlockState.complete Then
 
            Dim ubs As String = String.Empty
            For Each ub As UnterBlock In _unterblocks
                If ubs <> String.Empty Then
                    ubs &= " "
                End If
                ubs &= ub.ToString() & vbCrLf
            Next
 
            Dim sbs As String = String.Empty
 
            For Each bn As BlockName In _blockNames
                sbs &= bn.ToString() & vbCrLf
            Next
 
            Return String.Format("Blockname = {6} {8} Name = ""{0}"" {8} Nummer" & _
              "= {1} {8} Position = {2} {8} Option = {3} {8} {4} {5} {7}", _
              _name, _nummer, _position, _option, ubs, sbs, "{", "}", vbCrLf)
        End If
 
        Return "Blockname is in error"
 
    End Function
 
End Class

Public Class UnterBlock
    Private _typ As String
    Private _name As String
    Private _modell As String
 
    Private _state As BlockState = BlockState.uninitialised
 
    Public Property Typ() As String
        Get
            Return _typ
        End Get
        Set(ByVal value As String)
            _typ = value
        End Set
    End Property
 
    Public Property Name() As String
        Get
            Return _name
        End Get
        Set(ByVal value As String)
            _name = value
        End Set
    End Property
 
    Public Property Modell() As String
        Get
            Return _modell
        End Get
        Set(ByVal value As String)
            _modell = value
        End Set
    End Property
 
    Public ReadOnly Property State() As BlockState
        Get
            Return _state
        End Get
    End Property
 
    Public Sub New()
 
    End Sub
 
    Public Sub New(ByVal typ As String, ByVal name As String, ByVal modell As _
      String)
        _typ = typ
        _name = name
        _modell = modell
        _state = BlockState.complete
    End Sub
 
    Public Sub New(ByVal data As String)
 
        Debug.WriteLine("UnterBlockData:" & data)
        If data.StartsWith("{") AndAlso data.EndsWith("}") Then
            Dim kgrbn As New KeyGroupReader(data.Substring(1, data.Length - 2))
            Dim val As String
 
            val = kgrbn.GetKeywordParameter("Typ", Nothing)
            _typ = val
            val = kgrbn.GetKeywordParameter("Name", Nothing)
            _name = val
            val = kgrbn.GetKeywordParameter("Modell", Nothing)
            _modell = val
 
            _state = BlockState.complete
        Else
            _state = BlockState.inerror
        End If
    End Sub
 
    Public Overrides Function ToString() As String
 
        If _state = BlockState.complete Then
            Return String.Format("UnterBlock = {3} Typ = {0} Name = ""{1}""" & _
              "Modell = {2} {4}", _typ, _name, _modell, "{", "}")
        End If
 
        Return "UnterBlock is in error"
 
    End Function
 
End Class

Public Class KeyGroupReader
 
    Private npos As Integer
    Private data As String
    Private LastKeywordIntern As String
 
    Public Sub New(ByVal data As String)
        Me.data = data
    End Sub
 
    Public Function GetKeywordParameter(ByVal name As String, ByVal t As Type) _
      As String
        Dim val As String = String.Empty
        skipWhiteSpace()
        If npos < data.Length Then
            lastKeyWordIntern = getToken()
            Dim sep As String = getToken()
            val = getToken()
 
            If (name <> "?" AndAlso name <> lastKeyWordIntern) OrElse sep <> _
              "=" OrElse val = String.Empty Then
                If name <> "?" Then
                    MsgBox("Wrong!")
                End If
                Return String.Empty
            End If
        End If
        Return val
    End Function
 
    Public ReadOnly Property LastKeyword() As String
        Get
            Return lastKeyWordIntern
        End Get
    End Property
 
    Dim seps As Char() = {vbCr, vbLf, "=", "{", "}", " "}
 
    Private Function getToken() As String
        skipWhiteSpace()
 
        Dim spos As Integer = npos
        'Debug.WriteLine(data)
        If npos < data.Length Then
            Select Case data(npos)
                Case """"
                    Return getQuotedStringToken()
                Case "{"
                    Return getBlockDataToken()
 
                Case "="
                    npos += 1
                    Return data(npos - 1)
                Case Else
            End Select
 
            Do While npos < data.Length AndAlso Not seps.Contains(data(npos))
                npos += 1
            Loop
            Return data.Substring(spos, npos - spos)
        End If
        Return String.Empty
    End Function
 
    Private Function getQuotedStringToken() As String
        Dim spos = npos
        npos += 1
        Dim res As String = String.Empty
        While npos < data.Length
            If npos = data.Length OrElse data(npos) = """" Then
                npos += 1
                If npos < data.Length AndAlso data(npos) = """" Then
                    npos += 1
                    Continue While
                End If
                res = data.Substring(spos + 1, npos - spos - 2)
                Exit While
            End If
            npos += 1
        End While
        Return res
    End Function
 
    Private Function getBlockDataToken() As String
        Dim spos As Integer = npos
        Dim level As Integer
 
        If data(npos) = "{" Then
            npos += 1
            level += 1
            While npos < data.Length
                Select Case data(npos)
                    Case """"
                        getQuotedStringToken()
                    Case "{"
                        level += 1
                    Case "}"
                        level -= 1
                        If level = 0 Then Exit While
                End Select
                npos += 1
            End While
            npos += 1
            Return data.Substring(spos, npos - spos)
        Else
            If npos <> data.Length Then
                MsgBox("Invalid!!!")
            End If
        End If
        Return String.Empty
 
    End Function
 
    Private Sub skipWhiteSpace()
        While npos < data.Length AndAlso Char.IsWhiteSpace(data(npos))
            npos += 1
        End While
    End Sub
 
End Class

    Private BlockNames As New List(Of BlockName)
    Public Sub DoBlocks(ByVal pfad As String)
        Dim sr As New IO.StreamReader(pfad)
        Dim data As String = sr.ReadToEnd()
        sr.Close()
 
        Dim kgr As New KeyGroupReader(data)
        Dim blockNameData As String
 
        ' Process main blocks
        Do
            blockNameData = kgr.GetKeywordParameter("Blockname", Nothing)
            If blockNameData <> String.Empty Then
                Dim bn As New BlockName(blockNameData)
                If bn.State = BlockState.complete Then
                    BlockNames.Add(bn)
                Else
                    MsgBox("Invalid Blockname data")
                End If
            End If
 
        Loop While blockNameData <> String.Empty
 
        ' Display with ToString()
        For Each bn As BlockName In BlockNames
            Debug.WriteLine(bn.ToString())
        Next
 
        ' Temp write to xml
        Dim xs As New Xml.Serialization.XmlSerializer(BlockNames.GetType())
        Dim sw As New IO.StreamWriter("F:\Test\blocknames.xml")
        xs.Serialize(sw, BlockNames)
        sw.Close()
 
    End Sub

________
Alle Angaben ohne Gewähr. Keine Haftung für Vorschläge, Tipps oder sonstige Hilfe, falls es schiefgeht, nur Zeit verschwendet oder man sonst nicht zufrieden ist