Click here to Skip to main content
15,883,705 members
Articles / Desktop Programming / Windows Forms

i00 Spell Check and Control Extensions - No Third Party Components Required!

Rate me:
Please Sign up or sign in to vote.
4.95/5 (117 votes)
11 Jan 2014Ms-PL16 min read 1.3M   21   266  
Simple to use, open source Spell Checker for .NET
'©i00 Productions All rights reserved
'This article is derived from http://www.codeproject.com/Articles/33842/HTMLLabel-An-HTML-Label-for-the-NET-CF
'----------------------------------------------------------------------------------------------------
'
'i00 is not and shall not be held accountable for any damages directly or indirectly caused by the
'use or miss-use of this product.  This product is only a component and thus is intended to be used 
'as part of other software, it is not a complete software package, thus i00 Productions is not 
'responsible for any legal ramifications that software using this product breaches.

Imports System.Text
Imports System.Collections
Imports System.Collections.Generic

Public Class HTMLParser
    Friend NotInheritable Class HTMLColors
        Private Sub New()
        End Sub
        Shared _colors As New Dictionary(Of String, String)()

        Private Shared Sub setColors()
            _colors.Clear()

            _colors.Add("aliceblue", "#F0F8FF")
            _colors.Add("antiquewhite", "#FAEBD7")
            _colors.Add("aqua", "#00FFFF")
            _colors.Add("aquamarine", "#7FFFD4")
            _colors.Add("azure", "#F0FFFF")
            _colors.Add("beige", "#F5F5DC")
            _colors.Add("bisque", "#FFE4C4")
            _colors.Add("black", "#000000")
            _colors.Add("blanchedalmond", "#FFEBCD")
            _colors.Add("blue", "#0000FF")
            _colors.Add("blueviolet", "#8A2BE2")
            _colors.Add("brown", "#A52A2A")
            _colors.Add("burlywood", "#DEB887")
            _colors.Add("cadetblue", "#5F9EA0")
            _colors.Add("chartreuse", "#7FFF00")
            _colors.Add("chocolate", "#D2691E")
            _colors.Add("coral", "#FF7F50")
            _colors.Add("cornflowerblue", "#6495ED")
            _colors.Add("cornsilk", "#FFF8DC")
            _colors.Add("crimson", "#DC143C")
            _colors.Add("cyan", "#00FFFF")
            _colors.Add("darkblue", "#00008B")
            _colors.Add("darkcyan", "#008B8B")
            _colors.Add("darkgoldenrod", "#B8860B")
            _colors.Add("darkgray", "#A9A9A9")
            _colors.Add("darkgreen", "#006400")
            _colors.Add("darkkhaki", "#BDB76B")
            _colors.Add("darkmagenta", "#8B008B")
            _colors.Add("darkolivegreen", "#556B2F")
            _colors.Add("darkorange", "#FF8C00")
            _colors.Add("darkorchid", "#9932CC")
            _colors.Add("darkred", "#8B0000")
            _colors.Add("darksalmon", "#E9967A")
            _colors.Add("darkseagreen", "#8FBC8F")
            _colors.Add("darkslateblue", "#483D8B")
            _colors.Add("darkslategray", "#2F4F4F")
            _colors.Add("darkturquoise", "#00CED1")
            _colors.Add("darkviolet", "#9400D3")
            _colors.Add("deeppink", "#FF1493")
            _colors.Add("deepskyblue", "#00BFFF")
            _colors.Add("dimgray", "#696969")
            _colors.Add("dodgerblue", "#1E90FF")
            _colors.Add("firebrick", "#B22222")
            _colors.Add("floralwhite", "#FFFAF0")
            _colors.Add("forestgreen", "#228B22")
            _colors.Add("fuchsia", "#FF00FF")
            _colors.Add("gainsboro", "#DCDCDC")
            _colors.Add("ghostwhite", "#F8F8FF")
            _colors.Add("gold", "#FFD700")
            _colors.Add("goldenrod", "#DAA520")
            _colors.Add("gray", "#808080")
            _colors.Add("green", "#008000")
            _colors.Add("greenyellow", "#ADFF2F")
            _colors.Add("honeydew", "#F0FFF0")
            _colors.Add("hotpink", "#FF69B4")
            _colors.Add("indianred", "#CD5C5C")
            _colors.Add("indigo", "#4B0082")
            _colors.Add("ivory", "#FFFFF0")
            _colors.Add("khaki", "#F0E68C")
            _colors.Add("lavender", "#E6E6FA")
            _colors.Add("lavenderblush", "#FFF0F5")
            _colors.Add("lawngreen", "#7CFC00")
            _colors.Add("lemonchiffon", "#FFFACD")
            _colors.Add("lightblue", "#ADD8E6")
            _colors.Add("lightcoral", "#F08080")
            _colors.Add("lightcyan", "#E0FFFF")
            _colors.Add("lightgoldenrodyellow", "#FAFAD2")
            _colors.Add("lightgrey", "#D3D3D3")
            _colors.Add("lightgreen", "#90EE90")
            _colors.Add("lightpink", "#FFB6C1")
            _colors.Add("lightsalmon", "#FFA07A")
            _colors.Add("lightseagreen", "#20B2AA")
            _colors.Add("lightskyblue", "#87CEFA")
            _colors.Add("lightslategray", "#778899")
            _colors.Add("lightsteelblue", "#B0C4DE")
            _colors.Add("lightyellow", "#FFFFE0")
            _colors.Add("lime", "#00FF00")
            _colors.Add("limegreen", "#32CD32")
            _colors.Add("linen", "#FAF0E6")
            _colors.Add("magenta", "#FF00FF")
            _colors.Add("maroon", "#800000")
            _colors.Add("mediumaquamarine", "#66CDAA")
            _colors.Add("mediumblue", "#0000CD")
            _colors.Add("mediumorchid", "#BA55D3")
            _colors.Add("mediumpurple", "#9370D8")
            _colors.Add("mediumseagreen", "#3CB371")
            _colors.Add("mediumslateblue", "#7B68EE")
            _colors.Add("mediumspringgreen", "#00FA9A")
            _colors.Add("mediumturquoise", "#48D1CC")
            _colors.Add("mediumvioletred", "#C71585")
            _colors.Add("midnightblue", "#191970")
            _colors.Add("mintcream", "#F5FFFA")
            _colors.Add("mistyrose", "#FFE4E1")
            _colors.Add("moccasin", "#FFE4B5")
            _colors.Add("navajowhite", "#FFDEAD")
            _colors.Add("navy", "#000080")
            _colors.Add("oldlace", "#FDF5E6")
            _colors.Add("olive", "#808000")
            _colors.Add("olivedrab", "#6B8E23")
            _colors.Add("orange", "#FFA500")
            _colors.Add("orangered", "#FF4500")
            _colors.Add("orchid", "#DA70D6")
            _colors.Add("palegoldenrod", "#EEE8AA")
            _colors.Add("palegreen", "#98FB98")
            _colors.Add("paleturquoise", "#AFEEEE")
            _colors.Add("palevioletred", "#D87093")
            _colors.Add("papayawhip", "#FFEFD5")
            _colors.Add("peachpuff", "#FFDAB9")
            _colors.Add("peru", "#CD853F")
            _colors.Add("pink", "#FFC0CB")
            _colors.Add("plum", "#DDA0DD")
            _colors.Add("powderblue", "#B0E0E6")
            _colors.Add("purple", "#800080")
            _colors.Add("red", "#FF0000")
            _colors.Add("rosybrown", "#BC8F8F")
            _colors.Add("royalblue", "#4169E1")
            _colors.Add("saddlebrown", "#8B4513")
            _colors.Add("salmon", "#FA8072")
            _colors.Add("sandybrown", "#F4A460")
            _colors.Add("seagreen", "#2E8B57")
            _colors.Add("seashell", "#FFF5EE")
            _colors.Add("sienna", "#A0522D")
            _colors.Add("silver", "#C0C0C0")
            _colors.Add("skyblue", "#87CEEB")
            _colors.Add("slateblue", "#6A5ACD")
            _colors.Add("slategray", "#708090")
            _colors.Add("snow", "#FFFAFA")
            _colors.Add("springgreen", "#00FF7F")
            _colors.Add("steelblue", "#4682B4")
            _colors.Add("tan", "#D2B48C")
            _colors.Add("teal", "#008080")
            _colors.Add("thistle", "#D8BFD8")
            _colors.Add("tomato", "#FF6347")
            _colors.Add("turquoise", "#40E0D0")
            _colors.Add("violet", "#EE82EE")
            _colors.Add("wheat", "#F5DEB3")
            _colors.Add("white", "#FFFFFF")
            _colors.Add("whitesmoke", "#F5F5F5")
            _colors.Add("yellow", "#FFFF00")
            _colors.Add("yellowgreen", "#9ACD32")
        End Sub

        Public Shared Function GetColor(ByVal hexValue As String) As Color
            If (hexValue.StartsWith("#")) AndAlso (hexValue.Length = 7) Then
                Dim rgb As Integer = Integer.Parse("FF" & hexValue.Substring(1, 6), System.Globalization.NumberStyles.HexNumber)
                Dim c As Color = Color.FromArgb(rgb)
                Return Color.FromArgb(rgb)
            End If

            Return Color.Black
        End Function

        Public Shared Function GetColorByName(ByVal colorName As String) As Color
            colorName = colorName.Replace(" ", "").ToLower()
            If _colors.Count = 0 Then
                setColors()
            End If
            If _colors.ContainsKey(colorName) Then
                Return GetColor(_colors(colorName))
            End If

            Return Color.Black
        End Function
    End Class

    Friend Enum ElementType
        Status
        HTML
    End Enum

    Friend Class Element
        Private _type As ElementType
        Private _status As Status
        Private _html As HTMLParser.SimplePart
        Private _size As SizeF
        Private _dispRect As Rectangle

        Public Property DisplayedRect() As Rectangle
            Get
                Return _dispRect
            End Get
            Set(ByVal value As Rectangle)
                _dispRect = value
            End Set
        End Property

        Public Property HTML() As HTMLParser.SimplePart
            Get
                Return _html
            End Get
            Set(ByVal value As HTMLParser.SimplePart)
                _html = value
            End Set
        End Property

        Public Property Type() As ElementType
            Get
                Return _type
            End Get
            Set(ByVal value As ElementType)
                _type = value
            End Set
        End Property

        Public Property Status() As Status
            Get
                Return _status
            End Get
            Set(ByVal value As Status)
                _status = value
            End Set
        End Property

        Public Property Size() As SizeF
            Get
                Return _size
            End Get
            Set(ByVal value As SizeF)
                _size = value
            End Set
        End Property

        Public Sub New(ByVal status As Status)
            _type = ElementType.Status
            _status = New Status(status)
            _size = New SizeF(0, 0)
            _html = Nothing
        End Sub

        Public Sub New(ByVal html As HTMLParser.SimplePart)
            _type = ElementType.HTML
            _status = Nothing
            _html = html

            If TypeOf html Is HTMLParser.Text Then
                _size = New SizeF(0, 0)
                Return
            End If

            Throw New Exception("Unknown HTML element!")
        End Sub

        Public Overrides Function ToString() As String
            Select Case _type
                Case ElementType.Status
                    Return String.Format("STAT Element: stat={0};sz={1}", _status, _size.ToString())
                Case ElementType.HTML
                    Return String.Format("HTML Element: type={0};sz={1}", _html.Type.ToString(), _size.ToString())
            End Select

            Return "NULL Element"
        End Function
    End Class

    Friend Class TextLine
        Private _width As Single
        Private _height As Single
        Private _lastElement As Integer

        Public Property LastElement() As Integer
            Get
                Return _lastElement
            End Get
            Set(ByVal value As Integer)
                _lastElement = value
            End Set
        End Property

        Public Property Height() As Single
            Get
                Return _height
            End Get
            Set(ByVal value As Single)
                _height = value
            End Set
        End Property

        Public Property Width() As Single
            Get
                Return _width
            End Get
            Set(ByVal value As Single)
                _width = value
            End Set
        End Property

        Public Sub New(ByVal width As Single, ByVal height As Single, ByVal lastElement As Integer)
            _width = width
            _height = height
            _lastElement = lastElement
        End Sub

        Public Overrides Function ToString() As String
            Return String.Format("TextLine: w={0};h={1};le={2}", _width, _height, _lastElement)
        End Function
    End Class


    Friend Class Elements
        Private _elements As List(Of Element) = Nothing

        Public Sub New()
            _elements = New List(Of Element)()
        End Sub

        Public Function Parse(ByVal lineOfText As String, ByVal status As Status) As Status
            _elements.Clear()
            lineOfText = lineOfText.Replace(vbLf, "")
            lineOfText = lineOfText.Replace(vbCr, "")

            Dim brushes As New Stack(Of STRBrush)()
            Dim fonts As New Stack(Of STRFont)()

            brushes.Push(New STRBrush(status.Brush))
            fonts.Push(New STRFont(status.Font))

            _elements.Add(New Element(status))
            Dim parts As List(Of HTMLParser.Part) = HTMLParser.Parse.ParseAll(lineOfText)
            For Each part As HTMLParser.Part In parts
                If TypeOf part Is HTMLParser.Text Then
                    Dim text As HTMLParser.Text = DirectCast(part, HTMLParser.Text)
                    Dim words As String() = text.Value.Trim().Split(" "c)
                    For Each word As String In words
                        _elements.Add(New Element(New HTMLParser.Text(word)))
                    Next
                End If


                If TypeOf part Is HTMLParser.Tag Then
                    Dim tag As HTMLParser.Tag = DirectCast(part, HTMLParser.Tag)
                    Dim oldStatus As New Status(status)

                    Select Case tag.LName
                        Case "img"
                            Dim Src = tag.AttrList.Find("src")
                            If Src IsNot Nothing Then
                                If FileIO.FileSystem.FileExists(Src.Value) Then
                                    status.Image = New STRImage() With {.Image = Image.FromFile(Src.Value)}
                                End If
                            End If
                            GoTo AddElement
                        Case "br"
                            status.NewLine = True
                        Case "pre"
                            status.WordWrap = tag.[End]
                        Case Else
                            If tag.[End] Then
                                Select Case tag.LName
                                    Case "b"
                                        status.Font.Style = status.Font.Style And Not FontStyle.Bold
                                    Case "i"
                                        status.Font.Style = status.Font.Style And Not FontStyle.Italic
                                    Case "u"
                                        status.Font.Style = status.Font.Style And Not FontStyle.Underline
                                    Case "p"
                                        status.NewLine = True
                                        status.Alignment = ContentAlignment.TopLeft
                                    Case "font"
                                        Dim oldFS As FontStyle = status.Font.Style
                                        status.Brush = New STRBrush(If((brushes.Count > 1), brushes.Pop(), brushes.Peek()))
                                        status.Font = New STRFont(If((fonts.Count > 1), fonts.Pop(), fonts.Peek()))
                                        status.Font.Style = oldFS
                                End Select
                            Else
                                Select Case tag.LName
                                    Case "b"
                                        status.Font.Style = status.Font.Style Or FontStyle.Bold
                                    Case "i"
                                        status.Font.Style = status.Font.Style Or FontStyle.Italic
                                    Case "u"
                                        status.Font.Style = status.Font.Style Or FontStyle.Underline
                                    Case "p"
                                        status.NewLine = True
                                        status.Alignment = ContentAlignment.TopLeft
                                        Dim attr As HTMLParser.Attribute = tag.AttrList.Find("align")
                                        If attr IsNot Nothing Then
                                            If attr.LValue = "center" Then
                                                status.Alignment = ContentAlignment.TopCenter
                                            End If
                                            If attr.LValue = "right" Then
                                                status.Alignment = ContentAlignment.TopRight
                                            End If
                                        End If
                                    Case "font"
                                        brushes.Push(New STRBrush(status.Brush))
                                        fonts.Push(New STRFont(status.Font))

                                        Dim attr As HTMLParser.Attribute = tag.AttrList.Find("color")
                                        If attr IsNot Nothing Then
                                            If (attr.Value.Length = 7) AndAlso (attr.Value(0) = "#"c) Then
                                                status.Brush.Color = HTMLColors.GetColor(attr.Value)
                                            Else
                                                status.Brush.Color = HTMLColors.GetColorByName(attr.Value)
                                            End If
                                        End If

                                        attr = tag.AttrList.Find("size")
                                        If attr IsNot Nothing Then
                                            status.Font.Size = Convert.ToInt16(attr.Value)
                                        End If

                                        attr = tag.AttrList.Find("name")
                                        If attr IsNot Nothing Then
                                            status.Font.Name = attr.Value
                                        End If
                                End Select
                            End If
                    End Select

                    If oldStatus IsNot status Then
AddElement:
                        Dim element = New Element(status)
                        If status IsNot Nothing AndAlso status.Image IsNot Nothing Then
                            element.Status.Image = status.Image
                            status.Image = Nothing
                        End If
                        _elements.Add(element)
                        status.NewLine = False
                    End If
                End If
            Next

            Return New Status(status)
        End Function

        Public ReadOnly Property Value() As IList(Of Element)
            Get
                Return _elements
            End Get
        End Property

        Public Overrides Function ToString() As String
            Dim sb As New StringBuilder(1000)
            For Each elem As Element In _elements
                sb.Append(elem.ToString())
                sb.Append(vbLf)
            Next
            Return sb.ToString()
        End Function
    End Class


    Public Class STRFont
        Public Name As String
        Public Size As Integer
        Public Style As FontStyle

        Public Overrides Function ToString() As String
            Return String.Format("Font: {0}/{1} - {2}", Name, Size.ToString(), Style.ToString())
        End Function

        Public Function GetRealFont() As Font
            Return New Font(Name, Size, Style)
        End Function

        Public Sub New()
            Name = "Tahoma"
            Size = 10
            Style = FontStyle.Regular
        End Sub

        Public Sub New(ByVal oldFont As STRFont)
            Name = oldFont.Name
            Size = oldFont.Size
            Style = oldFont.Style
        End Sub

        Public Sub New(ByVal fnt As Font)
            Name = fnt.Name
            Size = CInt(Math.Truncate(fnt.Size))
            Style = fnt.Style
        End Sub

    End Class

    Public Class STRBrush
        Public Color As Color

        Public Overrides Function ToString() As String
            Return Color.ToString()
        End Function

        Public Function GetRealBrush() As Brush
            Return New SolidBrush(Color)
        End Function

        Public Sub New()
            Color = Color.Black
        End Sub

        Public Sub New(ByVal oldBrush As STRBrush)
            Color = oldBrush.Color
        End Sub

        Public Sub New(ByVal color As Color)
            Me.Color = color
        End Sub

    End Class

    Public Class STRImage
        Public Image As Image
        Public Size As Size
    End Class

    Public Class Status
        'Implements IComparable
        Public Image As STRImage
        Public NewLine As Boolean
        Public WordWrap As Boolean
        Public Alignment As ContentAlignment
        Public Font As STRFont
        Public Brush As STRBrush

        Public Sub New()
            Font = New STRFont()
            NewLine = False
            WordWrap = True
            Alignment = ContentAlignment.TopLeft
            Brush = New STRBrush()
        End Sub

        Public Sub New(ByVal oldSatus As Status)
            Font = New STRFont(oldSatus.Font)
            NewLine = oldSatus.NewLine
            WordWrap = oldSatus.WordWrap
            Alignment = oldSatus.Alignment
            Brush = New STRBrush(oldSatus.Brush)
        End Sub

    End Class










    Public Enum PartType
        Unknown
        Text
        ProcessInstruction
        Comment
        SpecialAnchore
        Tag
    End Enum

    Public Class Attribute
        Private _name As String
        Private _value As String
        Private _lname As String
        Private _lvalue As String

        Private Sub [set](ByVal name As String, ByVal value As String)
            _name = name
            _lname = name.ToLower()
            _value = value
            _lvalue = value.ToLower()
        End Sub

        Public Sub New(ByVal name As String, ByVal value As String)
            [set](name, value)
        End Sub

        Public Sub New(ByVal oldAttr As Attribute)
            [set](oldAttr.Name, oldAttr.Value)
        End Sub

        Public Property Name() As String
            Get
                Return _name
            End Get
            Set(ByVal value As String)
                _name = value
                _lname = value.ToLower()
            End Set
        End Property

        Public Property Value() As String
            Get
                Return _value
            End Get
            Set(ByVal value As String)
                _value = value
                _lvalue = value.ToLower()
            End Set
        End Property

        Public ReadOnly Property LName() As String
            Get
                Return _lname
            End Get
        End Property

        Public ReadOnly Property LValue() As String
            Get
                Return _lvalue
            End Get
        End Property

        Public Function GetValueAsFloat(ByVal defaultValue As Single) As Single
            Try
                Return CSng(Convert.ToDouble(_value))
            Catch generatedExceptionName As Exception
            End Try
            Return defaultValue
        End Function

        Public Overrides Function ToString() As String
            Return String.Format("Attribute: name={0};value={1}", _name, _value)
        End Function
    End Class

    Public Class AttributeList
        Protected _list As List(Of Attribute) = Nothing

        Public Sub New()
            _list = New List(Of Attribute)()
        End Sub

        Public Sub New(ByVal oldAttrList As AttributeList)
            _list = New List(Of Attribute)()
            For i As Integer = 0 To oldAttrList._list.Count - 1
                Add(New Attribute(oldAttrList._list(i)))
            Next
        End Sub

        Public Function Find(ByVal name As String) As Attribute
            name = name.ToLower()
            For Each attr As Attribute In _list
                If attr.LName = name Then
                    Return attr
                End If
            Next

            Return Nothing
        End Function

        Public Sub Add(ByVal a As Attribute)
            _list.Add(a)
        End Sub


        Public Overrides Function ToString() As String
            Dim sb As New StringBuilder(1024)
            For Each att As Attribute In _list
                sb.Append(att.ToString())
                sb.Append(vbLf)
            Next
            Return sb.ToString()
        End Function
    End Class

    Public Class Part
        Private _type As PartType

        Public Sub New(ByVal type As PartType)
            _type = type
        End Sub

        Public ReadOnly Property Type() As PartType
            Get
                Return _type
            End Get
        End Property
    End Class

    Public Class SimplePart
        Inherits Part
        Private _value As String

        Public Property Value() As String
            Get
                Return _value
            End Get
            Set(ByVal value As String)
                _value = value
            End Set
        End Property

        Public Sub New(ByVal type As PartType, ByVal text As String)
            MyBase.New(type)
            _value = text
        End Sub
    End Class

    Public Class Text
        Inherits SimplePart
        Public Sub New(ByVal value As String)
            MyBase.New(PartType.Text, value)
        End Sub

        Public Overrides Function ToString() As String
            Return String.Format("TEXT: {0}", Me.Value)
        End Function
    End Class

    Public Class ProcessInstruction
        Inherits SimplePart
        Public Sub New(ByVal value As String)
            MyBase.New(PartType.ProcessInstruction, value)
        End Sub

        Public Overrides Function ToString() As String
            Return String.Format("ProcInstr: {0}", Me.Value)
        End Function
    End Class

    Public Class Comment
        Inherits SimplePart
        Public Sub New(ByVal value As String)
            MyBase.New(PartType.Comment, value)
        End Sub

        Public Overrides Function ToString() As String
            Return String.Format("Comment: {0}", Me.Value)
        End Function
    End Class

    Public Class Tag
        Inherits Part
        Private _name As String
        Private _lname As String
        Private _end As Boolean
        Private _attrList As AttributeList = Nothing

        Private Sub [set](ByVal name__1 As String, ByVal [end] As Boolean, ByVal attrList As AttributeList)
            _end = [end]
            Name = name__1
            If attrList IsNot Nothing Then
                _attrList = New AttributeList(attrList)
            Else
                _attrList = Nothing
            End If
        End Sub

        Public Sub New(ByVal name As String, ByVal attrList As AttributeList)
            MyBase.New(PartType.Tag)
            [set](name, False, attrList)
        End Sub

        Public Property [End]() As Boolean
            Get
                Return _end
            End Get
            Set(ByVal value As Boolean)
                _end = value
            End Set
        End Property

        Public Property Name() As String
            Get
                Return _name
            End Get
            Set(ByVal value As String)
                If value.Length > 0 Then
                    If (value(0) = "/"c) OrElse (value(value.Length - 1) = "/"c) Then
                        Dim start As Integer = If((value(0) = "/"c), 1, 0)
                        _end = True
                        _name = value.Substring(start, value.Length - 1)
                        _lname = _name.ToLower()
                        Return
                    End If
                End If

                _name = value
                _lname = _name.ToLower()
            End Set
        End Property

        Public ReadOnly Property LName() As String
            Get
                Return _lname
            End Get
        End Property

        Public Property AttrList() As AttributeList
            Get
                Return _attrList
            End Get
            Set(ByVal value As AttributeList)
                _attrList = value
            End Set
        End Property

        Public Overrides Function ToString() As String
            Return String.Format("TAG: name={0};end={1}" & vbLf & "{2}", _name, _end, _attrList)
        End Function
    End Class

    Public Class Parse
        Private _source As String
        Private _source_with_guards As String
        Private _source_len As Integer
        Private _idx As Integer

        Private Sub eatWhiteSpace()
            While _idx < _source_len
                Dim ch As Char = _source_with_guards(_idx)
                If ch <> " "c AndAlso ch <> ControlChars.Tab AndAlso ch <> ControlChars.Lf AndAlso ch <> ControlChars.Cr Then
                    Return
                End If
                _idx += 1
            End While
        End Sub

        Private Function parseAttributeName() As String
            eatWhiteSpace()

            Dim start As Integer = _idx
            While _idx < _source_len
                Dim ch As Char = _source_with_guards(_idx)
                If ch = " "c OrElse ch = ControlChars.Tab OrElse ch = ControlChars.Lf OrElse ch = ControlChars.Cr OrElse (ch = "="c) OrElse (ch = ">"c) Then
                    Exit While
                End If

                _idx += 1
            End While

            Dim name As String = _source_with_guards.Substring(start, _idx - start)
            eatWhiteSpace()
            Return name
        End Function

        Private Function parseAttributeValue() As String
            If _source_with_guards(_idx) <> "="c Then
                Return ""
            End If

            _idx += 1
            eatWhiteSpace()

            Dim value As String = ""
            Dim ch As Char = _source_with_guards(_idx)

            If (ch = "'"c) OrElse (ch = """"c) Then
                Dim valueDelimeter As Char = ch
                _idx += 1
                Dim start As Integer = _idx
                While _source_with_guards(_idx) <> valueDelimeter
                    _idx += 1
                End While
                value = _source_with_guards.Substring(start, _idx - start)
                _idx += 1
            Else
                Dim start As Integer = _idx
                While (_idx < _source_len) AndAlso (ch <> " "c AndAlso ch <> ControlChars.Tab AndAlso ch <> ControlChars.Lf AndAlso ch <> ControlChars.Cr) AndAlso (_source_with_guards(_idx) <> ">"c)
                    _idx += 1
                End While

                value = _source_with_guards.Substring(start, _idx - start)
            End If
            eatWhiteSpace()

            Return value
        End Function

        Private Function parseTag() As Part
            If _source_with_guards(_idx) = "!"c Then
                If (_source_with_guards(_idx + 1) = "-"c) AndAlso (_source_with_guards(_idx + 2) = "-"c) Then
                    _idx += 3
                    Dim start As Integer = _idx
                    While _idx < _source_len
                        If (_source_with_guards(_idx) = "-"c) AndAlso (_source_with_guards(_idx + 1) = "-"c) AndAlso (_source_with_guards(_idx + 2) = ">"c) Then
                            Exit While
                        End If
                        _idx += 1
                    End While
                    Dim value As String = _source_with_guards.Substring(start, _idx - start)
                    If _idx < _source_len Then
                        _idx += 3
                    End If
                    Return New Comment(value)
                Else
                    _idx += 1
                    Dim start As Integer = _idx
                    While (_idx < _source_len) AndAlso (_source_with_guards(_idx) <> ">"c)
                        _idx += 1
                    End While

                    Dim [end] As Integer = _idx
                    If _idx < _source_len Then
                        [end] = _idx - 1
                        _idx += 1
                    End If
                    Return New ProcessInstruction(_source_with_guards.Substring(start, [end] - start))
                End If
            End If

            Dim start1 As Integer = _idx
            While _idx < _source_len
                Dim ch As Char = _source_with_guards(_idx)
                If ch = " "c OrElse ch = ControlChars.Tab OrElse ch = ControlChars.Lf OrElse ch = ControlChars.Cr OrElse ch = ">"c Then
                    Exit While
                End If
                _idx += 1
            End While
            Dim name As String = _source_with_guards.Substring(start1, _idx - start1)

            eatWhiteSpace()

            Dim attrList As New AttributeList()
            While _source_with_guards(_idx) <> ">"c
                Dim ParseName As String = parseAttributeName()

                If _source_with_guards(_idx) = ">"c Then
                    attrList.Add(New Attribute(ParseName, ""))
                    Exit While
                End If

                Dim ParseValue As String = parseAttributeValue()
                attrList.Add(New Attribute(ParseName, ParseValue))
            End While
            _idx += 1

            Return New Tag(name, attrList)
        End Function

        Private Function isEof() As Boolean
            Return (_idx >= _source_len)
        End Function

        Private Function parseNext() As Part
            Dim start As Integer = _idx

            If _source_with_guards(_idx) = "<"c Then
                Dim ch As Char = Char.ToUpper(_source_with_guards(_idx + 1))
                If (ch >= "A"c) AndAlso (ch <= "Z"c) OrElse (ch = "!"c) OrElse (ch = "/"c) Then
                    _idx += 1
                    Return parseTag()
                End If

                _idx += 1
            End If

            While _idx < _source_len
                Dim ch As Char = _source_with_guards(_idx)
                If _source_with_guards(_idx) = "<"c Then
                    Exit While
                End If
                _idx += 1
            End While

            Dim value As String = _source_with_guards.Substring(start, _idx - start)
            Return New Text(value)
        End Function

        Private Property source() As String
            Get
                Return _source
            End Get

            Set(ByVal value As String)
                _source = value
                _source_with_guards = _source & ChrW(0) & ChrW(0) & ChrW(0)
                _source_len = _source.Length
            End Set
        End Property

        Public Shared Function ParseAll(ByVal HTMLString As String) As List(Of Part)
            Dim retValue As New List(Of Part)()

            Dim parse As New Parse()
            parse.source = HTMLString
            While Not parse.isEof()
                retValue.Add(parse.parseNext())
            End While

            Return retValue
        End Function
    End Class

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Microsoft Public License (Ms-PL)


Written By
i00
Software Developer (Senior) i00 Productions
Australia Australia
I hope you enjoy my code. It's yours to use for free, but if you do wish to say thank you then a donation is always appreciated.
You can donate here.

Comments and Discussions