XmlParser (VB10)

XmlParser.vb

Imports System.IO
Imports System.Text

Public Class XmlParser
    Implements IDisposable

    Private _Stream As TextReader
    Public ReadOnly Property Stream As TextReader
        Get
            Return _Stream
        End Get
    End Property

    Private _Text As String
    Public ReadOnly Property Text As String
        Get
            Return _Text
        End Get
    End Property

    Private _Tag As String
    Public ReadOnly Property Tag As String
        Get
            Return _Tag
        End Get
    End Property


    Public Sub New(ByVal S As TextReader)
        _Stream = S
    End Sub

    Public Sub New(ByVal Src As String)
        Me.New(New StringReader(Src))
    End Sub

    Public Sub Dispose() Implements IDisposable.Dispose
        If Not _Stream Is Nothing Then _Stream.Dispose()
        _Stream = Nothing
    End Sub


    Private values As New Dictionary(Of String, String)

    Default Public ReadOnly Property Item(ByVal K As String) As String
        Get
            Dim R As String = Nothing
            If values.TryGetValue(K, R) Then Return R
            Return Nothing
        End Get
    End Property


    Private reserved As String

    Public Function Read() As Boolean
        _Text = Nothing
        _Tag = Nothing
        values.Clear()
        If _Stream Is Nothing Then Return False

        If Not reserved Is Nothing Then
            _Tag = reserved
            reserved = Nothing
        Else
            ReadText()
        End If
        Return True
    End Function

    Public Function Search(ByVal T As String, ByVal F As Func(Of Boolean)) As Boolean
        Do While Read()
            If _Tag = T AndAlso F() Then Return True
        Loop
        Return False
    End Function

    Public Sub SearchEach(ByVal T As String, ByVal F As Func(Of Boolean), ByVal A As Action)
        Dim E = "/" + _Tag
        Do While Read()
            If _Tag = E Then
                Exit Do
            ElseIf _Tag = T AndAlso F() Then
                A()
            End If
        Loop
    End Sub


    Private current As Integer

    Private Function ReadChar() As Integer
        If _Stream Is Nothing Then
            current = -1
        Else
            current = _Stream.Read
            If current = -1 Then Dispose()
        End If
        Return current
    End Function

    Private Sub ReadText()
        Dim CH As Char, T As New StringBuilder
        Do While ReadChar() <> -1
            CH = ChrW(current)
            If CH = "<" Then Exit Do
            T.Append(CH)
        Loop
        _Text = FromEntity(T.ToString)
        If CH = "<" Then ReadTag()
    End Sub

    Private Sub ReadTag()
        Dim CH As Char, T As New StringBuilder
        Do While ReadChar() <> -1
            CH = ChrW(current)
            If CH = ">" OrElse (CH = "/" AndAlso T.Length > 0) Then
                Exit Do
            ElseIf CH > " " Then
                T.Append(CH)
                If T.Length = 3 AndAlso T.ToString() = "!--" Then Exit Do
            ElseIf T.Length > 0 Then
                Exit Do
            End If
        Loop
        _Tag = T.ToString.ToLower
        If CH = "/" Then
            reserved = "/" + _Tag
            CH = ChrW(ReadChar())
        End If
        If CH <> ">" Then
            If _Tag = "!--" Then
                ReadComment()
            Else
                Do While ReadAttribute()
                Loop
            End If
        End If
    End Sub

    Private Sub ReadComment()
        Dim CH As Char, M = 0, CM As New StringBuilder
        Do While ReadChar() <> -1
            CH = ChrW(current)
            If CH = ">" AndAlso M >= 2 Then
                CM.Length -= 2
                Exit Do
            End If
            CM.Append(CH)
            If CH = "-" Then M += 1 Else M = 0
        Loop
        values("comment") = CM.ToString
    End Sub

    Private Function ReadAttribute() As Boolean
        Dim CH As Char, NM = ""
        Do
            NM = ReadValue(True)
            If NM Is Nothing Then Return False
            CH = ChrW(current)
            If CH = "/" Then reserved = "/" + _Tag
        Loop While NM = ""
        values(NM) = If(CH = "=", ReadValue(False), "")
        Return current <> Asc(">")
    End Function

    Private Function ReadValue(isLeft As Boolean) As String
        Dim CH As Char, V As New StringBuilder
        Do While ReadChar() <> -1
            CH = ChrW(current)
            If CH = ">" OrElse (isLeft AndAlso (CH = "=" OrElse CH = "/")) Then
                Exit Do
            ElseIf CH = """" Then
                Do While ReadChar() <> -1
                    CH = ChrW(current)
                    If CH = """" Then Exit Do
                    V.Append(CH)
                Loop
                Exit Do
            ElseIf CH > " " Then
                V.Append(CH)
            ElseIf V.Length > 0 Then
                Exit Do
            End If
        Loop
        Return If(V.Length = 0, Nothing, V.ToString)
    End Function

    Public Shared Function FromEntity(ByVal S As String) As String
        Return S.
            Replace("&lt;", "<").
            Replace("&gt;", ">").
            Replace("&quot;", """").
            Replace("&nbsp;", " ").
            Replace("&amp;", "&")
    End Function
End Class