fLaSh_CF
Banido
Boas;
Coloco aqui umas classes para fácil acesso ao XML a partir do VB6, sem necessitar de dependencias/componentes extra!.
Ideal para guardar informações como configurações da aplicação, registos, etc..
A engine contem três classes:
clsXMLAttr : esta class apena guarda temporariamente o "Item" da collection
clsXMLDoc: esta class é o principal motor da engine, faz o parsing do ficheiro XML
clsXMLNode: esta class é auxiliar da engine, armazena todos os nodes
E um module:
modGlobal: este module contem funções de leitura de ficheiros por API (é rapido), tambem funções importantes como XML Escape/Unescape (isto é importante!) para fazer o enconding/deconding de setrings com caracteres reservados por a linguagem XML.
Nota: os comentarios estão em EG, fiz esta engine para um projecto open source, talvez mais tarde eu traduza para PT
Depois de as classes e o module colucadas, pequeno exemplo do como utilizar:
clsXMLAttr
clsXMLDoc
clsXMLNode
modGlobal:
Podes fazer o download do project sample aqui:
http://www.megaupload.com/pt/?d=ZP3GGORE
Compr.
Coloco aqui umas classes para fácil acesso ao XML a partir do VB6, sem necessitar de dependencias/componentes extra!.
Ideal para guardar informações como configurações da aplicação, registos, etc..
A engine contem três classes:
clsXMLAttr : esta class apena guarda temporariamente o "Item" da collection
clsXMLDoc: esta class é o principal motor da engine, faz o parsing do ficheiro XML
clsXMLNode: esta class é auxiliar da engine, armazena todos os nodes
E um module:
modGlobal: este module contem funções de leitura de ficheiros por API (é rapido), tambem funções importantes como XML Escape/Unescape (isto é importante!) para fazer o enconding/deconding de setrings com caracteres reservados por a linguagem XML.
Nota: os comentarios estão em EG, fiz esta engine para um projecto open source, talvez mais tarde eu traduza para PT
Depois de as classes e o module colucadas, pequeno exemplo do como utilizar:
Código:
[B]frmMain:[/B]
Option Explicit
Private m_objSettings As New Settings
Private Sub LoadSettings()
Dim objNode As XMLNode
Dim objSubNode As XMLNode
'Does the Settings.xml file exist?
If PathExists(App.Path & "\Settings.xml") Then
'Parse XML file and get top level node
Set objNode = XMLParse(App.Path & "\Settings.xml", XML_FILE).Item("Settings")
For Each objNode In objNode.Nodes
Select Case CInt(objNode.GetAttr("Type"))
Case vbString
CallByName m_objSettings, objNode.Name, VbLet, CStr(objSubNode.Value)
Case vbLong
CallByName m_objSettings, objNode.Name, VbLet, CLng(objSubNode.Value)
Case vbBoolean
CallByName m_objSettings, objNode.Name, VbLet, CBool(objSubNode.Value)
Case vbInteger
CallByName m_objSettings, objNode.Name, VbLet, CInt(objSubNode.Value)
Case vbByte
CallByName m_objSettings, objNode.Name, VbLet, CByte(objSubNode.Value)
Case vbDouble
CallByName m_objSettings, objNode.Name, VbLet, CDbl(objSubNode.Value)
End Select
Next
End If
End Sub
Private Sub SaveSettings()
Dim intFF As Integer
Dim strFile As String
strFile = App.Path & "\Settings.xml"
intFF = FreeFile
Open strFile For Append As intFF
Print #intFF, vbXML
Print #intFF, "<Settings Version=""" & "1.0" & """>"
Print #intFF, vbTab & "<Longs>"
Print #intFF, vbTab & vbTab & "<Long1>" & m_objSettings.Long1 & "</Long1>"
Print #intFF, vbTab & vbTab & "<Long1>" & m_objSettings.Long1 & "</Long1>"
Print #intFF, vbTab & "</Longs>"
Print #intFF, vbTab & "<Integers>"
Print #intFF, vbTab & vbTab & "<Integer1>" & m_objSettings.Integer1 & "</Integer1>"
Print #intFF, vbTab & vbTab & "<Integer1>" & m_objSettings.Integer2 & "</Integer1>"
Print #intFF, vbTab & "</Integers>"
Print #intFF, vbTab & "<Booleans>"
Print #intFF, vbTab & vbTab & "<Boolean1>" & m_objSettings.Boolean1 & "</Boolean1>"
Print #intFF, vbTab & vbTab & "<Boolean1>" & m_objSettings.Boolean2 & "</Boolean2>"
Print #intFF, vbTab & "</Booleans>"
Print #intFF, vbTab & "<Strings>"
Print #intFF, vbTab & vbTab & "<String1>" & m_objSettings.String1 & "</String1>"
Print #intFF, vbTab & vbTab & "<String2>" & m_objSettings.String2 & "</String2>"
Print #intFF, vbTab & "</Strings>"
Print #intFF, vbTab & "<Bytes>"
Print #intFF, vbTab & vbTab & "<Byte1>" & m_objSettings.Byte1 & "</Byte1>"
Print #intFF, vbTab & vbTab & "<Byte2>" & m_objSettings.Byte2 & "</Bytes>"
Print #intFF, vbTab & "</Bytes>"
Print #intFF, "</Settings>";
Close intFF
End Sub
Private Sub cmdLoadSet_Click()
Set m_objSettings = New Settings
LoadSettings
End Sub
Private Sub cmdSaveSet_Click()
SaveSettings
End SubclsXMLAttr
Código:
'*******************************************
' Copyright: fLaSh - Carlos.DF
'Email: [EMAIL="[email protected]"][email protected][/EMAIL]
' 2008-10-19
'*******************************************
Option Explicit
Public Name As String
Public Value As StringclsXMLDoc
Código:
'*******************************************
' Copyright: fLaSh - Carlos.DF
'Email: [EMAIL="[email protected]"][email protected][/EMAIL]
' 2008-10-19
'*******************************************
Option Explicit
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" _
(Destination As Any, ByVal Length As Long)
Public Data As String
Public Flags As Long
Public Nodes As VBA.Collection
Private Const CHR_FSLASH As Integer = 47 '/
Private Const CHR_SQUOTE As Integer = 39 ''
Private Const CHR_DQUOTE As Integer = 34 '"
Private Sub Class_Initialize()
Set Nodes = New Collection
End Sub
Private Sub Class_Terminate()
Set Nodes = Nothing
End Sub
Public Function Parse() As VBA.Collection
'------------------------------------------------------------------
'Purpose: To parse XML data, and put the parsed data into XMLNode
' and XMLAttr objects which are stored in collections
'
' The collections are indexed by name; if more than one
' node has the same name, only the first is indexed
' (this makes the assumption that the parser user knows
' the format of the data it is requesting to be parsed)
'
' If XML_FILE is on, it must read the data from disk
' before popping it in a variable (otherwise it just
' copies the data from the Data variable)
'
' If XML_OVERWRITE is on, it will overwrite any nodes
' in the Nodes collection and will return a reference
' to Nodes; otherwise it will just create a new
' collection and it will be returned by the function
'
' While in properly formatted XML there should be only
' one top level node, multiple top level nodes are
' supported and are stored in the Nodes collection
'
'Returns: Collection containing top level nodes parsed
'------------------------------------------------------------------
Dim strData As String
Dim i As Byte
'Get the XML data
If Flags And XML_FILE Then
'It is on disk so read it
strData = ReadFile(Data)
Else
'Otherwise just make a copy into our local
'variable (modifications are made)
strData = Data
End If
'Remove comments / id tags
StripTags strData, "<!--", "-->"
StripTags strData, "<?", "?>"
'Remove the null characters
strData = Replace(strData, vbNullChar, vbNullString)
'Create a new collection
Set Parse = New Collection
'Are we supposed to overwrite data?
If Flags And XML_OVERWRITE Then
Set Nodes = Parse
End If
'Begin parsing!
ParseRec strData, Parse
End Function
Private Sub ParseRec(ByRef strData As String, ByVal colNodes As VBA.Collection)
'------------------------------------------------------------------
'Purpose: Recursive function which goes through all the data
' given to parse for XML until there is none left
'
'Params:
' strData: Data to parse
' colNodes: Current level collection of nodes
'------------------------------------------------------------------
Dim i As Long
Dim k As Long
Dim strValue As String
Dim strName As String
Dim objNode As XMLNode
'Find first <
i = InStrB(1, strData, "<")
'Keep looping while there are <
Do While i
'Alright there is a node; create a new one
Set objNode = New XMLNode
'Find end of first tag
k = InStrB(i, strData, ">")
'If there is no >, then we've got bad XML
If k = 0 Then
Exit Do
End If
'Extract data inbetween <>
strName = MidB$(strData, i + 2, k - i - 2)
'Check for a space in the name
i = InStrB(1, strName, " ")
'If there is a space, there may be attributes,
'otherwise no
If i Then
'Extract name of node
objNode.Name = LeftB$(strName, i - 1)
'Parse attributes if any
ParseAttr MidB$(strName, i + 2), objNode.Attributes
'If the name ends in a /, then there is no end tag
'otherwise there is
If AscW(RightB$(strName, 2)) = CHR_FSLASH Then
i = 0
Else
i = 1
End If
Else
'If the name ends in a /, then there is no end tag
'otherwise there is
If AscW(RightB$(strName, 2)) = CHR_FSLASH Then
'Trim off / from name
objNode.Name = LeftB$(strName, LenB(strName) - 2)
i = 0
Else
objNode.Name = strName
i = 1
End If
End If
'If i is non-zero, then we have to find the end tag
If i Then
'Find end tag position
i = InStrB(k, strData, "</" & objNode.Name & ">")
'Did we find it?
If i Then
'Extract value
strValue = MidB$(strData, k + 2, i - k - 2)
'Parse any nodes which might be inside
ParseRec strValue, objNode.Nodes
'Unescape escape sequences
objNode.Value = XMLUnescape(strValue)
'Should equal position of last character for this node
k = i + LenB(objNode.Name) + 4
Else
'Malformed XML; quit
Exit Do
End If
End If
'Remove parsed data from string
strData = MidB$(strData, k + 2)
'Index node in collection
On Error Resume Next
colNodes.Add objNode, objNode.Name
'If an error occured, then we should add it to
'the collection without indexing it (it's already taken)
If Err.Number Then
colNodes.Add objNode
'Clear error
Err.Clear
End If
'Find next <
i = InStrB(1, strData, "<")
Loop
End Sub
Private Sub ParseAttr(ByRef strAttr As String, ByVal colAttr As VBA.Collection)
'------------------------------------------------------------------
'Purpose: To parse an attribute list for an XML tag and to place
' them inside the collection
'
'Params:
' strAttr: List of attributes/values seperated by
' spaces
' colAttr: Collection to add XMLAttr objects to
'------------------------------------------------------------------
Dim c As Integer
Dim i As Long
Dim objAttr As XMLAttr
'Find first equal's sign
i = InStrB(1, strAttr, "=")
'Loop as long as there are attributes
Do While i
'Create new attribute
Set objAttr = New XMLAttr
'Extract name (may have leading space(s))
objAttr.Name = LTrim$(LeftB$(strAttr, i - 1))
'Skip ahead to value
strAttr = MidB$(strAttr, i + 2)
'Get first character
c = AscW(strAttr)
'How is the attributed formated; surrounding quotes or no?
Select Case c
Case CHR_SQUOTE, CHR_DQUOTE
'Find ending quote
i = InStrB(3, strAttr, ChrW$(c))
'Did we find it?
If i Then
'Extract value and skip past this attribute
objAttr.Value = XMLUnescape(MidB$(strAttr, 3, i - 3))
strAttr = MidB$(strAttr, i + 2)
Else
'Bad XML!
Exit Do
End If
Case Else
'A space then will herald then end
i = InStrB(1, strAttr, " ")
'Did we find one?
If i Then
'Extract value and then skip past current attribute data
objAttr.Value = XMLUnescape(LeftB$(strAttr, i - 1))
strAttr = MidB$(strAttr, i + 2)
Else
'It is the last attribute; copy remaining data and
'exit loop
objAttr.Value = XMLUnescape(strAttr)
Exit Do
End If
End Select
'Add to collection
colAttr.Add objAttr, objAttr.Name
'Find next attribute
i = InStrB(1, strAttr, "=")
Loop
End Sub
Public Function Generate() As String
'------------------------------------------------------------------
'Purpose: To generate the XML data from what is in the nodes
' collection automatically; it creates a temporary file
' and writes the data to this file
'
'Returns: If XML_FILE is on, it returns a file path otherwise
' it returns raw XML data
'------------------------------------------------------------------
Dim intFF As Integer
Dim strFile As String
strFile = TempFile()
intFF = FreeFile()
'Open file for appending, and generate XML data starting at top level node
Open strFile For Append Lock Write As intFF
GenerateRec intFF, Nodes
Close intFF
'XML generated, how to return to user
'Are with working with files or raw data?
If Flags And XML_FILE Then
'Are we allowed to overwrite things?
If Flags And XML_OVERWRITE Then
'If so, delete the old file, and rename the
'temporary one to the path of the old file
DeleteFile Data
Name strFile As Data
'Return path
Generate = Data
Else
'Return path to temporary file
Generate = strFile
End If
Else
'Are we allowed to overwrite raw data?
If Flags And XML_OVERWRITE Then
'If so, place a copy in Data and return the same
Data = ReadFile(strFile)
Generate = Data
Else
'Otherwise, just return the raw data
Generate = ReadFile(strFile)
End If
'Either way, we don't need this file anymore
DeleteFile strFile
End If
End Function
Private Sub GenerateRec(ByVal intFile As Integer, ByVal colNodes As VBA.Collection)
'------------------------------------------------------------------
'Purpose: Recursive function which goes down the node heirarchy
' to generate properly formatted XML
'
'Params:
' intFile: File handle where to write XML data
' colNodes: Reference to node collection at current
' level
'------------------------------------------------------------------
Dim objNode As XMLNode
Dim objAttr As XMLAttr
Dim colRef As VBA.Collection
For Each objNode In colNodes
'Print header
Print #intFile, "<" & objNode.Name;
Set colRef = objNode.Attributes
'Print out attributes if any
If colRef.Count Then
For Each objAttr In colRef
Print #intFile, " " & objAttr.Name & "=""" & XMLEscape(objAttr.Value) & """";
Next
End If
'End header
Print #intFile, ">";
Set colRef = objNode.Nodes
'If there are subnodes, there isn't any value to this node; in that case
'call GenerateRec again for nodes inside of this node
If colRef.Count Then
GenerateRec intFile, colRef
Else
Print #intFile, XMLEscape(objNode.Value);
End If
Set colRef = Nothing
'Print end of tag
Print #intFile, "</" & objNode.Name & ">"
Next
End Sub
Private Sub StripTags(ByRef strData As String, ByRef strStart As String, ByRef strEnd As String)
'------------------------------------------------------------------
'Purpose: Removes all characters inbetween and including the
' starting and ending sequences provided and replaces
' them with null characters
'
'Params:
' strData: String to strip (modifies original)
' strStart: Starting sequence
' strEnd: Ending sequence
'------------------------------------------------------------------
Dim i As Long
Dim k As Long
Dim h As Long
'Get the length of the ending term
h = LenB(strEnd)
'Remove comments
i = InStrB(1, strData, strStart)
Do While i
'Find ending
k = InStrB(i, strData, strEnd)
'If it exists, replace comment with null chars
'else replace the rest of the string with them
If k Then
ZeroMemory ByVal StrPtr(strData) + i - 1, k - i + h
Else
ZeroMemory ByVal StrPtr(strData) + i - 1, LenB(strData) - i + 1
Exit Do
End If
'Find next comment
i = InStrB(1, strData, strStart)
Loop
End SubclsXMLNode
Código:
'*******************************************
' Copyright: fLaSh - Carlos.DF
'Email: [EMAIL="[email protected]"][email protected][/EMAIL]
' 2008-10-19
'*******************************************
Option Explicit
Public Name As String
Public Value As String
Public Nodes As VBA.Collection
Public Attributes As VBA.Collection
Private Sub Class_Initialize()
Set Nodes = New Collection
Set Attributes = New Collection
End Sub
Private Sub Class_Terminate()
Set Nodes = Nothing
Set Attributes = Nothing
End Sub
Public Function GetAttr(ByRef strName As String) As String
'------------------------------------------------------------------
'Purpose: Get the value of an attribute directly from the name
' rather than use the collection (from the point of
' view of the caller)
'
'Params:
' strName: Name of the attribute to value of
'
'Returns: Value of attribute; if the attribute doesn't exist
' vbNullString is returned
'------------------------------------------------------------------
On Error Resume Next
GetAttr = Attributes(strName).Value
End Function
Public Function GetNode(ByRef strName As String) As XMLNode
'------------------------------------------------------------------
'Purpose: Get a node directly rather than from the collection
' to avoid un-useful error messages
'
'Params:
' strName: Name of node to retrieve
'
'Returns: Object reference to node if it exists, otherwise it
' returns Nothing
'------------------------------------------------------------------
On Error Resume Next
GetNode = Nodes(strName)
End FunctionmodGlobal:
Código:
'*******************************************
' Copyright: fLaSh - Carlos.DF
'Email: [EMAIL="[email protected]"][email protected][/EMAIL]
' 2008-10-19
'*******************************************
Option Explicit
'File searching APIs
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
'Get clock tick
Public Declare Function GetTickCount Lib "kernel32" () As Long
'File property API
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
'Structures for file searching APIs
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Public Const XML_FILE As Long = 1
Public Const XML_OVERWRITE As Long = 2
Public Const vbXML As String = "<?xml version=""1.0"" encoding=""windows-1252"" standalone=""yes"" ?>"
Public Sub WriteFile(ByRef strPath As String, ByRef strData As String, Optional ByVal blnText As Boolean = False)
'------------------------------------------------------------------
'Purpose: To write data to a file on disk. By default it writes
' in binary mode as it is faster (because it doesn't do
' any character translations)
'
'Params:
' strPath: Path to file to write to
' strData: Data to write to file
' blnText: Write in text (true) or binary (false)
'------------------------------------------------------------------
Dim intFF As Integer
'Get an unused file handle
intFF = FreeFile
'Are we writing in text or binary mode?
If blnText Then
Open strPath For Output As intFF
Else
Open strPath For Binary Access Write As intFF
End If
'Print characters to file
Put intFF, , strData
'Close the file handle
Close intFF
End Sub
Public Sub AppendFile(ByRef strPath As String, ByRef strData As String, Optional ByVal blnCR As Boolean = True)
'------------------------------------------------------------------
'Purpose: To append data to a file. By default adds a carriage
' return to the end of the data
'
'Params:
' strPath: Path to append to
' strData: Data to append to file
' blnCR: Add carriage return? (true to add)
'------------------------------------------------------------------
Dim intFF As Integer
'Get an unused file handle
intFF = FreeFile
'Open in Append mode
Open strPath For Append As intFF
'Print with carriage return by default, otherwise
'print without
If blnCR Then
Print #intFF, strData
Else
Print #intFF, strData;
End If
'Close file handle
Close intFF
End Sub
Public Sub DeleteFile(ByRef strPath As String)
'------------------------------------------------------------------
'Purpose: Deletes a file on disk
'
'Params:
' strPath: Path to file to be deleted
'------------------------------------------------------------------
On Error Resume Next
'Delete the file! (that was easy =)
Kill strPath
End Sub
Public Function ReadFile(ByRef strPath As String, Optional ByVal blnText As Boolean = False) As String
'------------------------------------------------------------------
'Purpose: To read data from a file on disk. By default it reads
' in binary mode as it does no character translations
'
'Params:
' strPath: Path to file to read
' blnText: Read in text (true) or binary (false) mode
'
'Returns: Data read from file
'------------------------------------------------------------------
Dim intFF As Integer
Dim i As Long
'Read only if the file exists
If PathExists(strPath) Then
'Get an unused file handle
intFF = FreeFile
'Are we reading in binary or in text mode?
'(default is binary as it is faster)
If blnText Then
Open strPath For Input As intFF
Else
Open strPath For Binary Access Read As intFF
End If
'If length is zero, we don't need to read from the file
i = LOF(intFF)
'Assuming the file has content, prepare a buffer
'and read data into that buffer
If i Then
ReadFile = Space$(i)
Get intFF, , ReadFile
End If
'Close file handle
Close intFF
End If
End Function
Public Function PathExists(ByRef strPath As String) As Boolean
'------------------------------------------------------------------
'Purpose: To determine if a path exists or not (works for both
' folders and files)
'
'Params:
' strPath: Path to check for existence
'
'Returns: True if it exists, false if not
'------------------------------------------------------------------
'API call returns -1 if the path is invalid
PathExists = Not (GetFileAttributes(strPath) = -1)
End Function
Public Function TempFile() As String
'------------------------------------------------------------------
'Purpose: To generate a path for a temporary file which is
' guarunteed not to be used by another process
'
'Returns: Path to file
'------------------------------------------------------------------
Randomize GetTickCount
'Keep looping until we find a file path which isn't used
Do
TempFile = App.Path & "\" & GetTickCount & Rnd & ".tmp"
Loop While PathExists(TempFile)
End Function
Public Function XMLEscape(ByRef strData As String) As String
'------------------------------------------------------------------
'Purpose: Converts characters that XML requires to be escaped
' into the proper escape sequence
'
'Params:
' strData: String to search for characters to escape
' in
'
'Returns: String with necessary characters escaped
'------------------------------------------------------------------
XMLEscape = strData
If LenB(XMLEscape) Then
'Check for the illegal characters
If InStrB(1, XMLEscape, "&") Then XMLEscape = Replace(XMLEscape, "&", "&")
If InStrB(1, XMLEscape, "<") Then XMLEscape = Replace(XMLEscape, "<", "<")
If InStrB(1, XMLEscape, ">") Then XMLEscape = Replace(XMLEscape, ">", ">")
If InStrB(1, XMLEscape, """") Then XMLEscape = Replace(XMLEscape, """", """)
If InStrB(1, XMLEscape, "'") Then XMLEscape = Replace(XMLEscape, "'", "'")
End If
End Function
Public Function XMLUnescape(ByRef strData As String) As String
'------------------------------------------------------------------
'Purpose: Converts escape sequences for XML into the actual
' characters
'
'Params:
' strData: String to search for escaped characters in
'
'Returns: String with escaped characters converted back to actual
' representation
'------------------------------------------------------------------
Dim i As Long
XMLUnescape = strData
If LenB(XMLUnescape) Then
i = InStrB(1, XMLUnescape, "&")
'If there is a & in the string, that is where we should start searching
If i Then
'Make sure there is a semi colon, telling us there may be escape sequences
If InStrB(i, XMLUnescape, ";") Then
'Escape various illegal characters
If InStrB(i, XMLUnescape, "<") Then XMLUnescape = Replace(XMLUnescape, "<", "<")
If InStrB(i, XMLUnescape, ">") Then XMLUnescape = Replace(XMLUnescape, ">", ">")
If InStrB(i, XMLUnescape, """) Then XMLUnescape = Replace(XMLUnescape, """, """")
If InStrB(i, XMLUnescape, "'") Then XMLUnescape = Replace(XMLUnescape, "'", "'")
If InStrB(i, XMLUnescape, "&") Then XMLUnescape = Replace(XMLUnescape, "&", "&")
End If
End If
End If
End Function
Public Function XMLParse(ByRef strData As String, ByVal lngFlags As Long) As VBA.Collection
'------------------------------------------------------------------
'Purpose: Wrapper method to quickly parse an XML document
'
'Params:
' strData: Data property of XMLDoc
' lngFlags: Flags property of XMLDoc
'
'Returns: Reference to top-level nodes collection
'------------------------------------------------------------------
Dim objXML As XMLDoc
'Create new XML object
Set objXML = New XMLDoc
'Copy data/flags params
objXML.Data = strData
objXML.Flags = lngFlags
'Parse / return collection
Set XMLParse = objXML.Parse()
'Destroy XMLDoc reference
Set objXML = Nothing
End FunctionPodes fazer o download do project sample aqui:
http://www.megaupload.com/pt/?d=ZP3GGORE
Compr.