1 Attachment(s)
Indent XML (without recursion)
This module allows you to indent XML before saving it to a file without using VB string functions. It does the work with an extremely small amount of code and does it properly using an XSL transformation instead of a recursive function.
This module is the result of this thread. I want to extend a huge "thank you" to MartinLiss for reasearching XSL transformations and solving this issue. :thumb:
It will transform your XML from this:
Code:
<Values><FirstName>Rod</FirstName><LastName>Stephenshgsgfs</LastName><Street>1234 Programmer Place</Street><City>Bugsville</City><State>CO</State><Zip>80276</Zip></Values>
to this:
Code:
<Values>
<FirstName>Rod</FirstName>
<LastName>Stephenshgsgfs</LastName>
<Street>1234 Programmer Place</Street>
<City>Bugsville</City>
<State>CO</State>
<Zip>80276</Zip>
</Values>
Attached is the module and a small sample project.
To use it in any project all you have to do is add a reference to any version of MSXML.dll to your poject then call IndentXML() and pass a DOMDocument (or DOMDocument26, DOMDocument30 or DOMDocument40) object to the sub. After that the .xml property of that DOMDocument will be tabbed properly.
UPDATES:
11/16/2005 - Added 2 optional arguments to the IndentXML subroutine:
1) bUnindent - Boolean value telling wether or to unindent the XMLDOM object passed into oXMLDoc.
2) bLeaveHeader - Removes a problems from the last version where a tag was automatically added to the top of the document. If you want this tag back, set this parameter to true.
Re: Indent XML (without recursion)
Updates made to remove the major problem (the XML tag that was forced onto the first line) and added the ability to unindent the XML.
Re: Indent XML (without recursion)
Your XSL based code works great, but there is one change I'm having some trouble implementing. What needs to change in the XSL file in order to not add an end tag? For example,
I don't want this:
<element attribute="value"/>
to be changed to this:
<element attribute="value">
</element>
I know it's just a matter of figuring out the XSL syntax, but I don't have time to learn XSL just to make this one change. Thanks for the help.
Re: Indent XML (without recursion)
I really can't answer your question for sure, but all I know is that <element attribute="value"/> isn't proper syntax in some XHTML browsers. I know this is XML and not broswer specific, but it might work is you do this instead:
<element attribute="value" />
Just a though. Maybe Marty could give his input on th XLS side of things.
Re: Indent XML (without recursion)
I'm just curious. Your code reads the XML and formats it properly then prints it into a textbox, but how can i get it to write back to the XML file properly formatted?
Would I have to add code like the following after it runs the IndentXML function:
VB Code:
Open App.Path & "\my.xml" For Output As #1
Print #1, oXMLDoc.xml
Close #1
Or is there another way to do it?
!!! EDIT !!!:
Nevermind, I figured it out. Just do this after the IndentXML function is called, or whenever you want to save the xml to a file:
VB Code:
oXMLDoc.save App.Path & "\my.xml"
!!! EDIT !!! :
I also want to make a suggestion to add to the code (or rather to change something in the code). In the IndentXML function, where it removes the header, it did not work properly for me. I am using MSXML 6.0 and the header that gets printed is only <?xml version="1.0"?>, so what I did is this:
original code:
VB Code:
' Get rid of the added header line
If Not bLeaveHeader Then
sResult = Replace$(sResult, "<?xml version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-16" & QT & "?>", vbNullString, , , vbTextCompare)
End If
new code:
Note: you will have to declare the following at the beginning of the function
VB Code:
Dim iStartHeader As Integer
Dim iEndHeader As Integer
Replace the original code with the following:
VB Code:
' Get rid of the added header line
iStartHeader = InStr(1, sResult, "<?xml")
If Not bLeaveHeader And iStartHeader > 0 Then
iEndHeader = InStr(iStartHeader, sResult, "?>") + 2
sResult = Replace$(sResult, Mid(sResult, iStartHeader, iEndHeader - iStartHeader), vbNullString, , , vbTextCompare)
End If
This way, it searches for the beginning of the header and if that exists, it searches for the rest of the line and removes it.
Re: Indent XML (without recursion)
Good stuff, Adamm. I probably won't be modifying this code considering I am busy with many projects and college right now, but feel free to modify it as you see fit and upload a new zip and add your name to the credits. Just make sure you specify all the things that are different between the two versions.
Re: Indent XML (without recursion)
Quote:
Originally Posted by takedownca
Your XSL based code works great, but there is one change I'm having some trouble implementing. What needs to change in the XSL file in order to not add an end tag? For example,
I don't want this:
<element attribute="value"/>
to be changed to this:
<element attribute="value">
</element>
I know it's just a matter of figuring out the XSL syntax, but I don't have time to learn XSL just to make this one change. Thanks for the help.
I changed the XSL_FILE to the following, and it appears to have solved the problem. I haven't debugged it, but it works for me. Not exactly sure why it works, though. My XPath and XSL is pretty rusty.
VB Code:
XSL_FILE = _
"<?xml version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-8" & QT & "?>" & vbCrLf & _
"<xsl:stylesheet version=" & QT & "1.0" & QT & " xmlns:xsl=" & QT & "http://www.w3.org/1999/XSL/Transform" & QT & ">" & vbCrLf & _
" <xsl:output method=" & QT & "xml" & QT & " version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-8" & QT & " indent=" & QT & sIndent & QT & "/>" & vbCrLf & _
" <xsl:template match=" & QT & "@* | node()[count(*)>0]" & QT & ">" & vbCrLf & _
" <xsl:copy>" & vbCrLf & _
" <xsl:apply-templates select=" & QT & "@* | node()" & QT & " />" & vbCrLf & _
" </xsl:copy>" & vbCrLf & _
" </xsl:template>" & vbCrLf & _
" <xsl:template match=" & QT & "node()[count(*)=0]" & QT & ">" & vbCrLf & _
" <xsl:copy>" & vbCrLf & _
" <xsl:apply-templates select=" & QT & "@*" & QT & " />" & vbCrLf & _
" </xsl:copy>" & vbCrLf & _
" </xsl:template>" & vbCrLf & _
"</xsl:stylesheet>"
Re: Indent XML (without recursion)
Great, very useful, many thanks.
Simply changed DOMDocument to DOMDocument60 and it works with Microsoft XML v6.0.
2 Attachment(s)
Re: Indent XML (without recursion)
While I can understand not wanting to roll your own code to accomplish this from dirt (i.e. String operations in VB code), this approach is probably worse than you could do in pure VB6. XSL is notoriously slow and the XSLT engine itself is tremendously bulky. Try testing with a 750KB XML document!
An obvious alternative if you are already loading an MSXML library is to use the SAX2 objects. They can make this is trivial matter, and do the entire thing far faster using far less memory.
Here is 100% of the code in this demo, and you can basically ignore everything outside of cmdReformat_Click:
Code:
Option Explicit
Private Sub ManageUI()
'Make UI changes based on the relationships of controls and their
'curent values.
chkStandalone.Enabled = chkOmitXMLDeclaration.Value <> vbChecked
End Sub
Private Sub chkOmitXMLDeclaration_Click()
ManageUI
End Sub
Private Sub cmdReformat_Click()
Dim rdrCompact As MSXML2.SAXXMLReader
Dim wrtFormatted As MSXML2.MXXMLWriter
Set wrtFormatted = New MSXML2.MXXMLWriter
With wrtFormatted
.omitXMLDeclaration = chkOmitXMLDeclaration.Value = vbChecked
.standalone = chkStandalone.Value = vbChecked
.indent = chkIndent.Value = vbChecked
.output = "" 'Tells MXXMLWriter we want Unicode String output.
Set rdrCompact = New MSXML2.SAXXMLReader
With rdrCompact
Set .contentHandler = wrtFormatted
Set .dtdHandler = wrtFormatted
Set .errorHandler = wrtFormatted
.putProperty "http://xml.org/sax/properties/lexical-handler", _
wrtFormatted
.putProperty "http://xml.org/sax/properties/declaration-handler", _
wrtFormatted
.parse txtOriginal.Text
End With
txtPrettied.Text = .output
End With
End Sub
Private Sub Form_Load()
ManageUI
End Sub
Re: Indent XML (without recursion)
Good to know, thanks. I'll try to use your code instead. But in my applications the files are rarely larger than 10KB. And it's only temporary as I'm planning to start working in VSTO/C# soon.
But anyway, always good to do things faster, thanks!
Quote:
Originally Posted by
dilettante
While I can understand not wanting to roll your own code to accomplish this from dirt (i.e. String operations in VB code), this approach is probably worse than you could do in pure VB6. XSL is notoriously slow and the XSLT engine itself is tremendously bulky. Try testing with a 750KB XML document!
An obvious alternative if you are already loading an MSXML library is to use the SAX2 objects. They can make this is trivial matter, and do the entire thing far faster using far less memory.
Here is 100% of the code in this demo, and you can basically ignore everything outside of
cmdReformat_Click:
Code:
Option Explicit
Private Sub ManageUI()
'Make UI changes based on the relationships of controls and their
'curent values.
chkStandalone.Enabled = chkOmitXMLDeclaration.Value <> vbChecked
End Sub
Private Sub chkOmitXMLDeclaration_Click()
ManageUI
End Sub
Private Sub cmdReformat_Click()
Dim rdrCompact As MSXML2.SAXXMLReader
Dim wrtFormatted As MSXML2.MXXMLWriter
Set wrtFormatted = New MSXML2.MXXMLWriter
With wrtFormatted
.omitXMLDeclaration = chkOmitXMLDeclaration.Value = vbChecked
.standalone = chkStandalone.Value = vbChecked
.indent = chkIndent.Value = vbChecked
.output = "" 'Tells MXXMLWriter we want Unicode String output.
Set rdrCompact = New MSXML2.SAXXMLReader
With rdrCompact
Set .contentHandler = wrtFormatted
Set .dtdHandler = wrtFormatted
Set .errorHandler = wrtFormatted
.putProperty "http://xml.org/sax/properties/lexical-handler", _
wrtFormatted
.putProperty "http://xml.org/sax/properties/declaration-handler", _
wrtFormatted
.parse txtOriginal.Text
End With
txtPrettied.Text = .output
End With
End Sub
Private Sub Form_Load()
ManageUI
End Sub
