Private Sub Create_XML_MKV3()
Dim xDom As DOMDocument
Dim xEL00 As IXMLDOMElement ' (E)lement(L)evel
Dim xEL01 As IXMLDOMElement
Dim xEL02 As IXMLDOMElement
Dim xEL03 As IXMLDOMElement
Dim xEL04 As IXMLDOMElement
Dim i&, lFN&
Dim sFpn1$, sFpn2$, sPretty$, sPth$, sFnm$, sExt$
Set xDom = New DOMDocument
Set xDomCur = xDom
sPth = Application.Path
sFnm = "mkv_xml_"
sExt = ".xml"
sFnm = sPth & "\" & sFnm
sFpn1 = sFnm & "1" & sExt
sFpn2 = sFnm & "2" & sExt
i = 1
With xDom
Call .appendChild(.createProcessingInstruction("xml", "version='1.0'"))
Set xEL00 = fn_AppChl("Chapters", , , xDomCur): Set xEleCur = xEL00: With xEL00
Set xEL01 = fn_AppChl("EditionEntry"): Set xEleCur = xEL01: With xEL01
Call fn_AppChl("EditionFlagHidden", "0")
Call fn_AppChl("EditionFlagDefault", "0")
Call fn_AppChl("EditionUID", "11681998431740745868")
For i = 1 To 5
Set xEL02 = fn_AppChl("ChapterAtom"): Set xEleCur = xEL02: With xEL02
'Call fn_AppChl("ChapterUID", CStr(i) & "0852046123242429605")
Call fn_AppChl("ChapterTimeStart", "0" & CStr(i) & ":00:00.000000000")
Call fn_AppChl("ChapterFlagHidden", "0")
Call fn_AppChl("ChapterFlagEnabled", "0")
Set xEL03 = fn_AppChl("ChapterDisplay"): Set xEleCur = xEL03: With xEL03
Call fn_AppChl("ChapterString", "Part " & CStr(i))
Call fn_AppChl("ChapterLanguage", "eng")
Call fn_AppChl("ChapterCountry", "gb")
End With ' xEL03
End With ' xEL02
Set xEleCur = xEL01
Next
End With ' xEL01
End With 'xEL00
Call .Save(sFpn1)
End With ' xDom
sPretty = PrettyPrintDocument(xDom)
Debug.Print sPretty
lFN = FreeFile
Open sFpn2 For Output As #lFN
Print #lFN, sPretty
Close #lFN
Stop
End Sub
Function fn_AppChl(pNam$, Optional pTxt$, Optional pDom As DOMDocument, Optional pPrn As Variant) As Variant
Dim xEle As IXMLDOMElement
Dim bDom As Boolean, bPrn As Boolean ' AppendChild
'Stop
bDom = (pDom Is Nothing)
bPrn = IsMissing(pPrn) ' Parent Object
If bDom Then Set pDom = xDomCur
If bPrn Then Set pPrn = xEleCur
Set xEle = pPrn.appendChild(pDom.createElement(pNam))
xEle.Text = pTxt
If bDom Then Set pDom = Nothing
If bPrn Then Set pPrn = Nothing
Set fn_AppChl = xEle
End Function
'http://stackoverflow.com/questions/1118576/how-can-i-pretty-print-xml-source-using-vb6-and-msxml
Public Function PrettyPrintDocument(Doc As DOMDocument) As String '(Doc As DOMDocument60)
PrettyPrintDocument = PrettyPrintXML(Doc.XML)
End Function
Public Function PrettyPrintXML(XML As String) As String
Dim Reader As New SAXXMLReader60
Dim Writer As New MXXMLWriter60
With Writer
.Indent = True
.standalone = False
.omitXMLDeclaration = False
.Encoding = "utf-8"
End With ' Writer
With Reader
Set .contentHandler = Writer
Set .dtdHandler = Writer
Set .ErrorHandler = Writer
Call .putProperty("http://xml.org/sax/properties/declaration-handler", _
Writer)
Call .putProperty("http://xml.org/sax/properties/lexical-handler", _
Writer)
Call .Parse(XML)
End With ' Reader
PrettyPrintXML = Writer.output
End Function
|