Traversing a XML document with DOM in VB
Hello. I am trying to create a VB interface that will open up a xml file, determine the value in the fields, and the display them in textboxes already on a VB form. From there, the code will allow the user to add, update or delete entries from the xml file. Is there any code out there that does this?
P.S. - The structure of my xml goes like the following:
<PARENT>
<CHILD>
<FIELD1/>
<FIELD2/>
<FIELDX/>
</CHILD>
</PARENT>
Thanks in advanced for help.
slimbx
P.S. - The structure of my xml goes like the following:
<PARENT>
<CHILD>
<FIELD1/>
<FIELD2/>
<FIELDX/>
</CHILD>
</PARENT>
Thanks in advanced for help.
slimbx
ASKER
Dave_Greene,
The code that you posted above works great. I will use this as a fallback if there is not an easier way to do what this code does. Do you know of a simpler way to do what this code does with less code? Thanks
slimbx
The code that you posted above works great. I will use this as a fallback if there is not an easier way to do what this code does. Do you know of a simpler way to do what this code does with less code? Thanks
slimbx
This is the easiest (programmatically) you can make the traversion of DOM Nodes. It keeps things simple from a programming standpoint. There may be easier ways to code the same, but this was built for jr. programmers to code against. And it was made to be relatively easy to append to and modify.
And thanks, I'm glad you like it :)
Work with it some more and you'll see it becomes simpler!
Work with it some more and you'll see it becomes simpler!
ASKER
Last question, what exactly is the User.xib file for? Is it some sort of validation file (dtd or schema)?
Thanks
slimbx
Thanks
slimbx
Actually, I was porting this file over the internet so I would zip the file up and call it User.xib... (xib) was just some stupid naming convention at the company I was consulting for.
ASKER
thats no problem then. thanks again.
slimbx
slimbx
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Option Explicit
'Private XML holders
Private m_ActiveNode As IXMLDOMNode
Const UserLNK As String = "Markup.xml"
Const UserFile As String = "User.xib"
'Private Data Members
Private m_BOF As Boolean
Private m_EOF As Boolean
Private m_ImgID As String
Private m_Line As Long
Private m_Offset As Long
Private m_Length As Long
Private m_Address As String
Private m_Filename As String
Private m_isModified As Boolean
Private m_Error As Long
Private m_szError As String
Private m_UserLnkFile As String
'Private Constants
Const SUCCESS As Boolean = True
Const FAIL As Boolean = Not SUCCESS
Public Property Get isModified() As Boolean
isModified = m_isModified
End Property
Public Property Let ImgID(ByVal newVal As String)
m_ImgID = newVal
End Property
Public Property Get ImgID() As String
ImgID = m_ActiveNode.Attributes.ge
End Property
Public Property Let Offset(ByVal newVal As Long)
m_Offset = newVal
End Property
Public Property Get Offset() As Long
If (m_ActiveNode.Attributes.g
Offset = 0
Else
Offset = CLng(m_ActiveNode.Attribut
End If
End Property
Public Property Let Length(ByVal newVal As Long)
m_Length = newVal
End Property
Public Property Get Length() As Long
If (m_ActiveNode.Attributes.g
Length = 0
Else
Length = CLng(m_ActiveNode.Attribut
End If
End Property
Public Property Let Line(ByVal newVal As Long)
m_Line = newVal
End Property
Public Property Get Line() As Long
If (m_ActiveNode.Attributes.g
Line = 0
Else
Line = CLng(m_ActiveNode.Attribut
End If
End Property
Public Property Let Address(ByVal newVal As String)
m_Address = newVal
End Property
Public Property Get Address() As String
Address = m_ActiveNode.Attributes.ge
End Property
Private Property Let EOF(ByVal newVal As Boolean)
m_EOF = newVal
End Property
Public Property Get EOF() As Boolean
EOF = m_EOF
End Property
Private Property Let BOF(ByVal newVal As Boolean)
m_BOF = newVal
End Property
Public Property Get BOF() As Boolean
BOF = m_BOF
End Property
Public Property Get FullPath() As String
FullPath = GetTempPath() + UserFile
End Property
Public Property Get fileName() As String
fileName = m_Filename
End Property
Public Property Get Error() As Long
Error = m_Error
End Property
Public Property Get ErrorDesc() As String
ErrorDesc = m_szError
End Property
Public Sub MoveFirst()
Set m_ActiveNode = m_XML_DOM.selectSingleNode
If Not m_ActiveNode Is Nothing Then
m_BOF = True
m_EOF = False
Else
m_EOF = True
End If
End Sub
Public Sub MoveLast()
If Not m_ActiveNode.lastChild Is Nothing Then
Set m_ActiveNode = m_ActiveNode.lastChild
End If
m_EOF = True
m_BOF = False
End Sub
Public Sub MoveNext()
If Not m_ActiveNode.nextSibling Is Nothing Then
Set m_ActiveNode = m_ActiveNode.nextSibling
Else
m_EOF = True
End If
End Sub
Public Sub MovePrev()
If Not m_ActiveNode.previousSibli
Set m_ActiveNode = m_ActiveNode.previousSibli
Else
m_BOF = True
End If
End Sub
Private Function SearchItem(nLine As Long, nOffset As Long) As IXMLDOMNode
Set SearchItem = m_XML_DOM.selectSingleNode
$eq$ " & nOffset & "]")
End Function
Public Function SetItem(nLineNo As Long, nOffset As Long) As Boolean
SetItem = FAIL
Set m_ActiveNode = m_XML_DOM.selectSingleNode
$eq$ " & nOffset & "]")
If Not m_ActiveNode Is Nothing Then SetItem = SUCCESS
End Function
Public Function AddItem() As Boolean
On Error GoTo EH
AddItem = FAIL
Dim oRoot As IXMLDOMNode
Dim oNode As IXMLDOMNode
Dim oChild As IXMLDOMNode
Dim oAttrib As IXMLDOMAttribute
If m_XML_DOM Is Nothing Then
Set m_XML_DOM = New DOMDocument
'
' New Document, add headings
'
Set oNode = m_XML_DOM.createProcessing
Set oNode = m_XML_DOM.insertBefore(oNo
'
' Create document roots
'
Set oRoot = m_XML_DOM.createElement("M
Set m_XML_DOM.documentElement = oRoot
Set oChild = m_XML_DOM.createElement("H
oRoot.appendChild oChild
End If
Set oRoot = m_XML_DOM.selectSingleNode
Set oChild = oRoot.selectSingleNode("Hy
'
' Set the root document element to be appended to.
'
Set oRoot = m_XML_DOM.selectSingleNode
'
' add item
'
Set oNode = m_XML_DOM.createElement("L
oRoot.appendChild oNode
'
' set node attributes
'
Set oAttrib = m_XML_DOM.createAttribute(
oAttrib.Text = m_Line
oNode.Attributes.setNamedI
Set oAttrib = m_XML_DOM.createAttribute(
oAttrib.Text = m_Offset
oNode.Attributes.setNamedI
Set oAttrib = m_XML_DOM.createAttribute(
oAttrib.Text = m_Length
oNode.Attributes.setNamedI
Set oAttrib = m_XML_DOM.createAttribute(
oAttrib.Text = m_ImgID
oNode.Attributes.setNamedI
Set oAttrib = m_XML_DOM.createAttribute(
oAttrib.Text = m_Address
oNode.Attributes.setNamedI
m_isModified = True
AddItem = SUCCESS
Set oRoot = Nothing
Set oNode = Nothing
Set oChild = Nothing
Set oAttrib = Nothing
Exit Function
EH:
ProcessError
End Function
Public Function RemoveItem(nLineNo As Long, nOffset As Long) As Boolean
On Error GoTo EH:
RemoveItem = FAIL
Dim oNode As IXMLDOMNode
Dim oChild As IXMLDOMNode
Set oNode = m_XML_DOM.selectSingleNode
Set oChild = SearchItem(nLineNo, nOffset)
If Not oChild Is Nothing Then
oNode.removeChild oChild
RemoveItem = SUCCESS
m_isModified = True
End If
Set oNode = Nothing
Set oChild = Nothing
Exit Function
EH:
ProcessError
End Function
Public Function EditItem(nLineNo As Long, nOffset As Long) As Boolean
On Error GoTo EH:
EditItem = FAIL
Const EditAddr As Byte = 1
Dim oNode As IXMLDOMNode
Dim oChild As IXMLDOMNode
Dim oUpdateChild As IXMLDOMNode
Set oNode = m_XML_DOM.selectSingleNode
'
' set desired node
'
Set oChild = SearchItem(nLineNo, nOffset)
If Not oChild Is Nothing Then
'
' copy old child to child to be updated
'
Set oUpdateChild = oChild
With oUpdateChild.Attributes
If .getNamedItem("ImgID").Tex
Dim strTemp As String
Dim strFileOnly As String
strTemp = .getNamedItem("Address").T
'
' check for web address
'
If InStr(1, strTemp, "http://") = 0 Then
'
' check for local file
'
If InStr(2, strTemp, ":\") Then
'
' local file, remove the file location
'
strFileOnly = StripPath(strTemp)
'
' change address value
'
.getNamedItem("Address").T
End If
End If
End If
End With
'
' replace old node with updates
'
oNode.replaceChild oUpdateChild, oChild
EditItem = SUCCESS
End If
Set oNode = Nothing
Set oChild = Nothing
Set oUpdateChild = Nothing
Exit Function
EH:
MsgBox Err.Number & Err.Description
ProcessError
End Function
Public Function Load(ByVal szFileName As String) As Boolean
Load = FAIL
'
' Capture VDF File name
'
m_Filename = szFileName
Set m_XML_DOM = New DOMDocument
m_XML_DOM.async = False
'
' open XML document
'
If (m_XML_DOM.Load(m_UserLnkF
'
' seek to desired element
'
Dim oParent As IXMLDOMNode
Set oParent = m_XML_DOM.selectSingleNode
If Not oParent Is Nothing Then Load = SUCCESS
Set oParent = Nothing
Else
ProcessError
End If
End Function
Public Function Save(szVDFFile As String) As Boolean
Dim Zip As New CDynaZip
Dim XIBRead As New viVDFReader.VDFXib
Save = FAIL
MoveFirst
'
' Edit to remove temp file directory structure
'
Do While Not EOF
EditItem Line, Offset
MoveNext
Loop
'
' save XML file to temp directory
'
m_XML_DOM.Save m_UserLnkFile
'
' zip file into a file called user.xib
'
If (Zip.AddFile(FullPath, m_UserLnkFile)) Then
'
' save user.xib to the VDF file
'
Save = XIBRead.SaveToZipFile(szVD
End If
End Function
Private Sub ProcessError()
On Error Resume Next
Dim Error As IXMLDOMParseError
Set Error = m_XML_DOM.parseError
m_Error = Error.ErrorCode
m_szError = Error.reason + "Line: " + CStr(Error.Line)
Set Error = Nothing
End Sub
Private Sub Class_Initialize()
m_UserLnkFile = GetTempPath() + UserLNK
End Sub
Private Sub Class_Terminate()
Set m_XML_DOM = Nothing
Set m_ActiveNode = Nothing
End Sub
<< here is the XML... >>
<?xml version="1.0"?>
<Markup>
<HyperLinks>
<Link Line="26" Offset="1102" Length="29" ImgID="" Address="http://www.yahoo.com/"/>
<Link Line="21" Offset="841" Length="24" ImgID="" Address="http://www.search.com/"/>
<Link Line="28" Offset="1216" Length="21" ImgID="" Address="http://www.cnn.com/"/>
<Link Line="37" Offset="1479" Length="27" ImgID="" Address="http://www.otcstreet.com/trivia/otctrivia.cfm"/>
</HyperLinks>
</Markup>
And it works Like a recordset ...
With objClass 'object of XML class above
Do While Not .EOF
If .ImgID = 100 Then
msgbox .Address
exit do
end if
.MoveNext
Loop
End With