Code aus Form1.frm
Option Explicit
Private Sub cmdCreate_Click()
  Dim x() As Symbol, i As Long, xNode As Node, root As Long
  Dim positions() As Long, followpos() As Menge, s As String
  Dim eingabezeichen() As Long, match() As Menge, zustaende() As Zustand
  Dim listitem As listitem, n As Long, col As ColumnHeader
  Dim leer As Boolean, e As Long, endsymptr As Long
    
    'regulärer Ausdruck für den Scanner
    '\\.[\da-fA-F]*|\.|\[.*(\\.+)*\]
    'Test x, Meta, "\\", Meta, ".", Meta_Or, "|", Meta, "\.", _
        Meta_Or, "|", Meta, "\[", Meta, ".", MetaOp, "*", BR_Open, _
        "(", Meta, "\\", Meta, ".", MetaOp, "+", BR_Close, ")", _
        MetaOp, "*", Meta, "\]"
    ', Meta_Or, "|", Meta, "\|", Meta_Or, "|", Meta, "\*", _
        Meta_Or, "|", Meta, "\+", Meta_Or, "|", Meta, "\?", _
        Meta_Or, "|", Meta, "\(", Meta_Or, "|", Meta, "\)", _
        Meta_Or, "|", Meta, "."
    'Debug.Print lexcat(x, 0, UBound(x))
    
    Scanner.Scan txtRegEx.Text, x
    root = LR_Parser.Parse(x, endsymptr)
    Konstruktor.BildeMengen x, root, endsymptr, positions, _
        followpos, eingabezeichen, match, zustaende
    
    Debug.Print lexcat(x, 0, UBound(x))
    
    If txtFilepath.Text <> "" Then
      If Dir(txtFilepath.Text) <> "" Then
        Kill txtFilepath.Text: DoEvents
      End If
      Open txtFilepath.Text For Binary As #1
      Put #1, , UBound(zustaende)
      For i = 1 To UBound(zustaende)
        Put #1, , zustaende(i).acc
        Put #1, , zustaende(i).tran
      Next i
      Close #1
    End If
    
    On Error Resume Next
    
    TreeView1.Nodes.Clear
    List1.Clear
    List2.Clear
    ListView1.ListItems.Clear
    
    Set xNode = TreeView1.Nodes.Add(, , , x(root).lexeme)
    xNode.Expanded = True
    
    If chkAttributes.Value = vbChecked Then
      ShowAttributes x, xNode, root
    End If
    
    i = x(root).Child(0)
    If Err.Number <> 0 Then
      Err.Clear
      ReDim x(root).Child(0)
      x(root).Child(0) = -1
    End If
    
    For i = 0 To UBound(x(root).Child)
      If x(root).Child(i) >= 0 Then
        BuildNode x, xNode, x(root).Child(i)
      End If
    Next i
    
    For i = 1 To UBound(zustaende)
      List2.AddItem "Zustand " & CStr(i) & ": {" & _
          CatElemente(zustaende(i).pos) & "}"
    Next i
    
    For i = 0 To UBound(positions)
      If positions(i) >= 0 Then
        List1.AddItem "Pos " & i & ": " & x(positions(i)).lexeme
      End If
    Next i
    
    For i = 0 To UBound(followpos)
      List1.AddItem "Followpos(" & i & ") = {" & _
          CatElemente(followpos(i)) & "}"
    Next i
    
    For i = 0 To UBound(match)
      List1.AddItem "Chr: " & _
          IIf(InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRST" & _
          "UVWXYZäöüÄÖÜß0123456789.,-:;_#'+*~´`?\}][{!""§$%&/()=^°|" & _
          "<>€", Chr$(i)) > 0, Chr$(i), CStr(i)) & " - {" & _
          CatElemente(match(i)) & "}"
    Next i
    
    For i = 0 To UBound(eingabezeichen)
      If eingabezeichen(i) >= 0 Then
        List1.AddItem "Eingabe: " & x(eingabezeichen(i)).lexeme
      End If
    Next i
    
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "Positionen"
    s = _
        "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZäöüÄÖÜ" & _
        "ß0123456789.,-:;_#'+*~´`?\}][{!""§$%&/()=^°|<>€"
    
    For i = 1 To UBound(zustaende)
      Set listitem = ListView1.ListItems.Add(, , "{" & _
          CatElemente(zustaende(i).pos) & "}" & _
          IIf(zustaende(i).acc, " acc", ""))
      For n = 0 To 255
        For e = 1 To UBound(zustaende)
          leer = zustaende(e).tran(n) = 0
          If Not leer Then
            Exit For
          End If
        Next e
        If Not leer Then
          If i = 1 Then
            Set col = ListView1.ColumnHeaders.Add(, , IIf(InStr(s, _
                Chr$(n)) > 0, Chr$(n), CStr(n)), 20)
            col.Alignment = lvwColumnCenter
          End If
          listitem.ListSubItems.Add , , IIf(zustaende(i).tran(n) _
              <> -1, CStr(zustaende(i).tran(n)), "")
        End If
      Next n
    Next i
End Sub
Private Sub BuildNode(ByRef Stream() As Symbol, par As Node, ptr _
    As Long)
  Dim xNode As Node, i As Long
    
    Set xNode = TreeView1.Nodes.Add(par, tvwChild, , Stream(ptr).lexeme)
    xNode.Expanded = True
    
    If chkAttributes.Value = vbChecked Then
      ShowAttributes Stream, xNode, ptr
    End If
    
    On Error Resume Next
    i = Stream(ptr).Child(0)
    If Err.Number <> 0 Then
      Err.Clear
      ReDim Stream(ptr).Child(0)
      Stream(ptr).Child(0) = -1
    End If
    
    For i = 0 To UBound(Stream(ptr).Child)
      If Stream(ptr).Child(i) >= 0 Then
        BuildNode Stream, xNode, Stream(ptr).Child(i)
      End If
    Next i
End Sub
Private Sub ShowAttributes(ByRef Stream() As Symbol, xNode As _
    Node, ptr As Long)
  Dim sym As Symbol, attr As Sym_Attr, i As Long
  Dim id As String, val As String, match() As Menge
    
    sym = Stream(ptr)
    
    On Error Resume Next
    i = sym.attr(0).val
    If Err.Number <> 0 Then
      Err.Clear
      ReDim sym.attr(0)
    End If
    
    For i = 0 To UBound(sym.attr)
      If sym.attr(i).id > 0 Then
        id = "Unbekannt": val = CStr(sym.attr(i).val)
        
        Select Case sym.attr(i).id
          Case Sym_Attr_ID.pos: id = "Position"
          Case Sym_Attr_ID.nullable
            id = "Nullable"
            val = IIf(sym.attr(i).val = -1, "False", "True")
        End Select
        
        TreeView1.Nodes.Add xNode, tvwChild, , id & ": " & val
      End If
    Next i
    
    i = sym.First(0)
    If Err.Number <> 0 Then
      Err.Clear
      ReDim sym.First(0)
      sym.First(0) = -1
    End If
    
    If sym.First(0) >= 0 Then
      val = ""
      For i = 0 To UBound(sym.First)
        val = val & CStr(sym.First(i)) & ", "
      Next i
      val = Left$(val, Len(val) - 2)
      
      TreeView1.Nodes.Add xNode, tvwChild, , "First: {" & val & "}"
    End If
    
    i = sym.Last(0)
    If Err.Number <> 0 Then
      Err.Clear
      ReDim sym.Last(0)
      sym.Last(0) = -1
    End If
    
    If sym.Last(0) >= 0 Then
      val = ""
      For i = 0 To UBound(sym.Last)
        val = val & CStr(sym.Last(i)) & ", "
      Next i
      val = Left$(val, Len(val) - 2)
      
      TreeView1.Nodes.Add xNode, tvwChild, , "Last: {" & val & "}"
    End If
End Sub
Private Sub cmdBrowse_Click()
    CommonDialog.ShowOpen
    txtFilepath.Text = CommonDialog.FileName
End Sub