我是否有可能在使用 MSXML 在 Vb6 中创建时限制 XML 的大小?
例如,我必须创建一个类似 2GB 的 XML 文件,但我希望将其拆分为 4 个 500MB 的文件或 2 个 1GB 的文件。
请让我知道解决这个问题的正确方向。
谢谢。
This code uses MSXML SAX to write huge amounts of XML, broken into smaller files by testing the size of the output as it goes.
It requires an IStream as MXXMLWriter.output
and we don't have such an object opened directly on disk in VB6, so a reference to the "olelib" type library is used here. You can get this at:
Namespace Edanmo Visual Basic 6 OLELIB.TLB - OLE interfaces & functions v1.7
This is a widely-used type library for such things. The version at that link is actually 1.81 currently.
The code has a loop that writes out simple dummy XML, iterating from 1 to NUM_DETAIL_ELEMS
as it goes. A new output stream is opened on a new file every FILE_LIMIT_BYTES
of output. To check this, each CHECK_LIMIT_INTERVAL
iteration the MXXMLWriter
is flushed to the stream and the stream's size in bytes is checked.
Pretty basic really.
Option Explicit
'
'Simple demonstration of using MSXML SAX to create an XML document.
'
'Requires a reference to:
'
' Edanmo's OLE interfaces and functions v 1.81 or similar.
'
Private Stream As olelib.IStream
Private Sub StreamOpen(ByVal FileName As String)
Set Stream = _
olelib.SHCreateStreamOnFile(FileName, _
STGM_CREATE _
Or STGM_WRITE _
Or STGM_SHARE_EXCLUSIVE)
End Sub
Private Sub StreamClose()
Set Stream = Nothing
End Sub
Private Function StreamLength() As Long
Dim STATSTG As olelib.STATSTG
Stream.Stat STATSTG, STATFLAG_NONAME
'Convert pseudo-Currency ULARGE_INTEGER to Long:
StreamLength = STATSTG.cbSize * 10000@
End Function
Private Function StreamIsOpen() As Boolean
StreamIsOpen = Not Stream Is Nothing
End Function
Private Sub cmdCreate_Click()
Const CHECK_LIMIT_INTERVAL As Long = 100
Const FILE_LIMIT_BYTES As Long = 1000000
Const NUM_DETAIL_ELEMS As Long = 100000
Dim Attributes As SAXAttributes
Dim Writer As MSXML2.MXXMLWriter
Dim Handler As MSXML2.IVBSAXContentHandler
Dim I As Long
Dim FileNum As Long
Set Attributes = New MSXML2.SAXAttributes
Set Writer = New MSXML2.MXXMLWriter
Set Handler = Writer
With Writer
.omitXMLDeclaration = False
.standalone = True
.disableOutputEscaping = False
.indent = False 'True = use vbNewLine and vbTab,
'False = no indenting.
' .encoding = "ascii"
' .encoding = "windows-1252"
.encoding = "utf-8"
' .encoding = "unicode"
.byteOrderMark = True 'Has no effect for 8-bit encodings.
End With
For I = 1 To NUM_DETAIL_ELEMS
If Not StreamIsOpen() Then
FileNum = FileNum + 1
StreamOpen "doc" & Format$(FileNum, "00") & ".xml"
Writer.output = Stream
With Handler
.startDocument
.startElement "", "", "document", Attributes
End With
End If
With Handler
If Not Writer.indent Then
'Use custom whitespace:
.ignorableWhitespace vbLf & Space$(4)
End If
With Attributes
.addAttribute "", "", "a", "", Hex$(Int(Rnd() * &H7FFFFFFF))
.addAttribute "", "", "b", "", Hex$(Int(Rnd() * &H7FFFFFFF))
.addAttribute "", "", "c", "", Hex$(Int(Rnd() * &H7FFFFFFF))
End With
.startElement "", "", "detail", Attributes
Attributes.Clear
.characters ChrW$(&HD8&) _
& Format$(DateAdd("n", _
Int(Rnd() * 10000000) - 5000000, _
Now()), _
"dddddd ttttt")
.endElement "", "", "detail"
End With
If I Mod CHECK_LIMIT_INTERVAL = 0 Then
Writer.flush
If StreamLength() >= FILE_LIMIT_BYTES Then GoSub CloseDocument
End If
Next
If StreamIsOpen() Then GoSub CloseDocument
lblStatus.Caption = "Done!"
Exit Sub
CloseDocument:
With Handler
If Not Writer.indent Then
.ignorableWhitespace vbLf
End If
.endElement "", "", "document"
.endDocument
End With
StreamClose
Return
End Sub