Tidy XML Menggunakan XSL Transform - VB6 Source Code

Private Function TidyXML(sXML As String) As String
    Dim oXSLT As DOMDocument
    Dim XSL_FILE As String
    Dim sResult As String
    Const DoubleQuotes = """"
    Dim strText As String
    Dim objDom As DOMDocument
 
    Set objDom = New DOMDocument
    objDom.loadXML sXML
 
    Set oXSLT = New DOMDocument
    XSL_FILE = "<?xml version=" & DoubleQuotes & "1.0" & DoubleQuotes & " encoding=" & DoubleQuotes & "UTF-8" & DoubleQuotes & "?>" & vbCrLf & "<xsl:stylesheet version=" & DoubleQuotes & "1.0" & DoubleQuotes & " xmlns:xsl=" & DoubleQuotes & "http://www.w3.org/1999/XSL/Transform" & DoubleQuotes & ">" & vbCrLf & "     <xsl:output method=" & DoubleQuotes & "xml" & DoubleQuotes & " version=" & DoubleQuotes & "1.0" & DoubleQuotes & " encoding=" & DoubleQuotes & "UTF-8" & DoubleQuotes & " indent=" & DoubleQuotes & "yes" & DoubleQuotes & "/>" & vbCrLf & "     <xsl:template match=" & DoubleQuotes & "@* | node()" & DoubleQuotes & ">" & vbCrLf & "          <xsl:copy>" & vbCrLf & "               <xsl:apply-templates select=" & DoubleQuotes & "@* | node()" & DoubleQuotes & " />" & vbCrLf & "          </xsl:copy>" & vbCrLf & "     </xsl:template>" & vbCrLf & "</xsl:stylesheet>"
    objDom.async = False
    oXSLT.async = False
    oXSLT.loadXML XSL_FILE
    If oXSLT.parseError.errorCode = 0 Then
        If oXSLT.readyState = 4 Then
            sResult = objDom.transformNode(oXSLT.documentElement)
            sResult = Replace$(sResult, "<?xml version=" & DoubleQuotes & "1.0" & DoubleQuotes & " encoding=" & DoubleQuotes & "UTF-16" & DoubleQuotes & "?>", vbNullString, , , vbTextCompare)
            objDom.loadXML sResult
        End If
    Else
        Debug.Print Err.Description = oXSLT.parseError.reason & vbCrLf & "Line: " & oXSLT.parseError.Line & vbCrLf & "XML: " & oXSLT.parseError.srcText
        Err.Clear
    End If
 
    strText = objDom.xml
 
    TidyXML = strText
End Function