XML Writer class + usage example

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

XML Writer class + usage example

Logged in as: Guest

arrSession:exec spGetSession 2,16,55850

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> XML Writer class + usage example
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

XML Writer class + usage example - 1/23/2008 12:01:01 AM

geezery

Posts: 22
Score: 0
Joined: 5/28/2007
Status: offline

I have not done everything by myself, but I have added some functions that I needed to the class. It can handle all XML encodings that are available.

'Sample usage
'-------------------------------------------------------

Dim oXMLTextWriter
Set objShell = CreateObject("WScript.Shell")
Set oXMLTextWriter=New cXMLTextWriter
'Write the XML-file using the XMLWriteClass
With oXMLTextWriter
  .WriteProcessingInstruction("UTF-8")
  .WriteStartDocument "Sample"
  .WriteStartElement "NodeOne"
  .WriteStartElement "SubNodeOne"
  .WriteAttributeString "IsNode","Yes"
  .WriteString "Read & Write Node<yea!>"
  .WriteEndElement
  .WriteEndElement
  .WriteElementString "NodeTwo","Node2Text"
  .WriteEndDocument
  .WriteToFile("C:\Sample.xml")
End With

'Show the output file with Internet Explorer
objShell.Run "iexplore C:\Sample.xml"

'XML Write class
'-------------------------------------------------------

Class cXMLTextWriter
Private oXML, oCurrentNode, bDocStarted, bDocClosed, mOpenElements
Public PreserveEmptyNodes
Private Sub Class_Initialize()
Set oXML=CreateObject("MSXML2.DomDocument")
PreserveEmptyNodes=true
mOpenElements=0
bDocStarted=false
bDocClosed=true
End Sub
Private Sub Class_Terminate()
Set oXML=Nothing
End Sub
Public Function WriteProcessingInstruction(enc)
i = UCase(enc)
if i = "UTF-8" or i = "UTF-16" or i = "UCS-2" or i = "UCS-4" or i = "ISO-10646-UCS-2" or i = "UNICODE-1-1-UTF-8" or i = "UNICODE-2-0-UTF-16" or i = "UNICODE-2-0-UTF-8" or i = "US-ASCII" or i = "ISO-8859-1" or i = "ISO-8859-2" or i = "ISO-8859-3" or i = "ISO-8859-4" or i = "ISO-8859-5" or i = "ISO-8859-6" or i = "ISO-8859-8" or i = "ISO-8859-9" or i = "ISO-8859-10" or i = "WINDOWS-1250" or i = "WINDOWS-1251" or i = "WINDOWS-1252" or i = "WINDOWS-1253" or i = "WINDOWS-1254" or i = "WINDOWS-1255" or i = "WINDOWS-1256" or i = "WINDOWS-1257" or i = "WINDOWS-1258" then
Set ndDecl  = oXML.createProcessingInstruction( "xml", "version=""1.0"" encoding=" & Chr(34) & enc & Chr(34) & "")
oXML.appendChild(ndDecl)
Else
err.Raise vbObjectError + 2, "cXMLTextWriter","Unknown encoding " & enc & " :" & vbCrLf & vbCrLf & "Native Values:" & vbCrLf & vbCrLf & "UTF-8" & vbCrLf & "UTF-16" & vbCrLf & "UCS-2" & vbCrLf & "UCS-4" & vbCrLf & "ISO-10646-UCS-2" & vbCrLf & "UNICODE-1-1-UTF-8" & vbCrLf & "UNICODE-2-0-UTF-16" & vbCrLf & "UNICODE-2-0-UTF-8 " & vbCrLf & vbCrLf & "Also regognized values:" & vbCrLf & vbCrLf & "US-ASCII" & vbCrLf & "ISO-8859-1" & vbCrLf & "ISO-8859-2" & vbCrLf & "ISO-8859-3" & vbCrLf & "ISO-8859-4" & vbCrLf & "ISO-8859-5" & vbCrLf & "ISO-8859-6" & vbCrLf & "ISO-8859-7" & vbCrLf & "ISO-8859-8" & vbCrLf & "ISO-8859-9" & vbCrLf & "WINDOWS-1250" & vbCrLf & "WINDOWS-1251" & vbCrLf & "WINDOWS-1252" & vbCrLf & "WINDOWS-1253" & vbCrLf & "WINDOWS-1254" & vbCrLf & "WINDOWS-1255" & vbCrLf & "WINDOWS-1256" & vbCrLf & "WINDOWS-1257" & vbCrLf & "WINDOWS-1258" & vbCrLf & vbCrLf 
End If
End Function

Public Function WriteStartDocument(TagName)
if not bDocStarted then 
Set oXML.documentElement=oXML.createElement(TagName)
Set oCurrentNode=oXML.documentElement
bDocStarted=true
bDocClosed=false
else
err.Raise vbObjectError + 1, "cXMLTextWriter", "The document has already been started"
end if
End Function
Public Function WriteToFile(Filename)
Dim oFS    : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim sFSpec : sFSpec  = oFS.GetAbsolutePathName(Filename)
oXML.Save sFSpec
End Function
Public Function WriteEndDocument()
if mOpenElements=0 then
bDocClosed=true
else
err.Raise vbObjectError + 3, "cXMLTextWriter", "You will have " & mOpenElements & " open element(s). Most Recent: " & oCurrentNode.TagName
end if
End Function
Public Function WriteStartElement(TagName)
if bDocStarted and not bDocClosed then
Dim oNewNode
Set oNewNode=oXML.createElement(TagName)
oCurrentNode.appendChild oNewNode
Set oCurrentNode=oNewNode
mOpenElements=mOpenElements+1
else
err.Raise vbObjectError + 2, "cXMLTextWriter", "Either the document is not started or has been closed"
end if
End Function 
Public Function WriteEndElement()
if bDocStarted and not bDocClosed then
Set oCurrentNode=oCurrentNode.parentNode
mOpenElements=mOpenElements-1
else
err.Raise vbObjectError + 2, "cXMLTextWriter", "Either the document is not started or has been closed"
end if
End Function
Public Function WriteString(Text)
if bDocStarted and not bDocClosed then
oCurrentNode.text = Text
else
err.Raise vbObjectError + 2, "cXMLTextWriter", "Either the document is not started or has been closed"
end if
End Function
Public Function WriteAttributeString(AttributeName, AttributeValue)
if bDocStarted and not bDocClosed then
oCurrentNode.setAttribute AttributeName, AttributeValue
else
err.Raise vbObjectError + 2, "cXMLTextWriter", "Either the document is not started or has been closed"
end if
End Function
Public Function WriteElementString(TagName, NodeText)
if bDocStarted and not bDocClosed then
if len(NodeText)>0 or PreserveEmptyNodes then 'only write if there is a value
 Dim oNewNode
 Set oNewNode=oXML.createElement(TagName)
 if len(NodeText)>0 then oNewNode.text=NodeText
 oCurrentNode.appendChild oNewNode
end if
else
err.Raise vbObjectError + 2, "cXMLTextWriter", "Either the document is not started or has been closed"
end if
End Function
Public Property Get xml()
if bDocClosed Then
xml=oXML.xml
else
err.Raise vbObjectError + 4, "cXMLTextWriter", "You must first close the document"
end if
End Property
Public Property Get xmlObject()
if bDocClosed Then
Set xmlObject=oXML
else
err.Raise vbObjectError + 4, "cXMLTextWriter", "You must first close the document"
end if
End Property
End Class