XhtmlTextWriter

Das .NET-Framework bietet eine ausgezeichnete Unterstützung für XML 1.0. Es deckt jedoch nicht die Kompatibilitätsrichtlinien von XHTML 1.0 ab, die es HTML-Benutzeragenten ermöglichen, XHTML-Dokumente zu verarbeiten.

In .NET übernimmt ein System.Xml.XmlTextWriter die Serialisierung eines XML-Dokuments. Meine Klasse Schneegans.Xml.XhtmlTextWriter ist von XmlTextWriter abgeleitet und durch folgende Erweiterungen in der Lage, HTML-kompatibles XHTML auszugeben:

Sub Main()

    Dim doc As New System.Xml.XmlDocument
    doc.LoadXml("<html><head/><body title='&apos;'><br/><hr></hr></body></html>")

    Dim xtw As New Schneegans.Xml.XhtmlTextWriter(Console.Out)
    xtw.QuoteChar = "'"c

    doc.WriteTo(xtw)

End Sub

erzeugt bspw. folgende Ausgabe:

<html><head></head><body title='&#39;'><br /><hr /></body></html>

Hier der Quelltext der Klasse:

Option Explicit On 
Option Strict On

Public Class XhtmlTextWriter : Inherits System.Xml.XmlTextWriter

    'Soll "@" codiert werden?
    Public EscapeAt As Boolean = False

    'XHTML-Elemente mit leerem Inhaltsmodell.
    Public EmptyElements() As String = New String() {"area", "base", "basefont", "br", "col", "frame", "hr", "img", "input", "isindex", "link", "meta", "param"}

    'Wir müssen immer wissen, welche Elemente gerade geöffnet sind.
    Private ElementStack As New System.Collections.Stack

    'Alle Konstruktoren, die auch XmlTextWriter anbietet.
    Public Sub New(ByVal w As System.IO.Stream, ByVal encoding As System.Text.Encoding)
        MyBase.New(w, encoding)
    End Sub

    Public Sub New(ByVal filename As String, ByVal encoding As System.Text.Encoding)
        MyBase.New(filename, encoding)
    End Sub

    Public Sub New(ByVal w As System.IO.TextWriter)
        MyBase.New(w)
    End Sub

    Public Overrides Sub WriteEndElement()

        Dim localName As String = CStr(ElementStack.Pop)

        '"<script />" darf wegen der Kompatibilitätsrichtlinien niemals ausgegeben werden.
        If System.Array.IndexOf(EmptyElements, localName) <> -1 Then

            'Bspw. "<input />"
            MyBase.WriteEndElement()

        Else

            'Bspw. "<script></script>"
            MyBase.WriteFullEndElement()

        End If

    End Sub

    Public Overrides Sub WriteFullEndElement()

        Me.WriteEndElement()

    End Sub

    Public Overloads Overrides Sub WriteStartElement(ByVal prefix As String, ByVal localName As String, ByVal ns As String)

        Me.ElementStack.Push(localName)
        MyBase.WriteStartElement(prefix, localName, ns)

    End Sub

    Public Overrides Sub WriteString(ByVal [text] As String)

        If Me.EscapeAt Then

            If Me.WriteState = WriteState.Attribute AndAlso Me.QuoteChar = "'"c Then
                Me.WriteEscapedString([text], New Char() {"@"c, "'"c})
            Else
                Me.WriteEscapedString([text], New Char() {"@"c})
            End If

        Else

            If Me.WriteState = WriteState.Attribute AndAlso Me.QuoteChar = "'"c Then
                Me.WriteEscapedString([text], New Char() {"'"c})
            Else
                MyBase.WriteString([text])
            End If

        End If

    End Sub

    Private Sub WriteEscapedString(ByVal [text] As String, ByVal escapeChars As Char())

        Dim pos1 As Integer = 0
        Dim pos2 As Integer = [text].IndexOfAny(escapeChars)

        Do While pos2 <> -1
            MyBase.WriteString([text].Substring(pos1, pos2 - pos1))
            MyBase.WriteRaw("&#" & Microsoft.VisualBasic.AscW([text].Chars(pos2)) & ";")
            pos1 = pos2 + 1
            pos2 = [text].IndexOfAny(escapeChars, pos1)
        Loop

        MyBase.WriteString([text].Substring(pos1))

    End Sub

    Public Overrides Sub WriteChars(ByVal buffer() As Char, ByVal index As Integer, ByVal count As Integer)

        Me.WriteString(New String(buffer, index, count))

    End Sub

    '"&apos;" ist in HTML nicht definiert, vgl. <http://www.w3.org/TR/xhtml1/#C_16>.
    Public Overrides Sub WriteEntityRef(ByVal name As String)

        If name = "apos" Then
            Me.WriteRaw("&#39;")
        Else
            MyBase.WriteEntityRef(name)
        End If

    End Sub
    
    'XmlTextWriter bevorzugt offenbar hexadezimale numerische Zeichenreferenzen.
    'Dezimale werden aber von einigen Browsern besser unterstützt.
    Public Overrides Sub WriteCharEntity(ByVal ch As Char)

        Me.WriteRaw("&#" & Microsoft.VisualBasic.AscW(ch) & ";")

    End Sub    

End Class