Solved

Traversing a XML document with DOM in VB

Posted on 2001-07-09
8
326 Views
Last Modified: 2013-11-19
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
0
Comment
Question by:slimbx
  • 5
  • 3
8 Comments
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6270396
Here is a class module I use to manipulate XML

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.getNamedItem("ImgID").Text
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.getNamedItem("Offset").Text) = "" Then
       Offset = 0
   Else
       Offset = CLng(m_ActiveNode.Attributes.getNamedItem("Offset").Text)
   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.getNamedItem("Length").Text) = "" Then
       Length = 0
   Else
       Length = CLng(m_ActiveNode.Attributes.getNamedItem("Length").Text)
   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.getNamedItem("Line").Text) = "" Then
       Line = 0
   Else
       Line = CLng(m_ActiveNode.Attributes.getNamedItem("Line").Text)
   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.getNamedItem("Address").Text
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("Markup/HyperLinks/Link")
   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.previousSibling Is Nothing Then
       Set m_ActiveNode = m_ActiveNode.previousSibling
   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("Markup/HyperLinks/Link[@Line $eq$ " & nLine & "][@Offset
$eq$ " & nOffset & "]")
   
End Function

Public Function SetItem(nLineNo As Long, nOffset As Long) As Boolean

   SetItem = FAIL
   
   Set m_ActiveNode = m_XML_DOM.selectSingleNode("Markup/HyperLinks/Link[@Line $eq$ " & nLineNo & "][@Offset
$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.createProcessingInstruction("xml", "version='1.0'")
       Set oNode = m_XML_DOM.insertBefore(oNode, m_XML_DOM.childNodes.Item(0))
       
       '
       ' Create document roots
       '
       Set oRoot = m_XML_DOM.createElement("Markup")
       Set m_XML_DOM.documentElement = oRoot
       
       Set oChild = m_XML_DOM.createElement("HyperLinks")
       oRoot.appendChild oChild

   End If
   

   Set oRoot = m_XML_DOM.selectSingleNode("Markup")
   Set oChild = oRoot.selectSingleNode("HyperLinks")
   
   '
   ' Set the root document element to be appended to.
   '
   Set oRoot = m_XML_DOM.selectSingleNode("Markup/HyperLinks")
   
   '
   ' add item
   '
   Set oNode = m_XML_DOM.createElement("Link")
   oRoot.appendChild oNode
   
   '
   ' set node attributes
   '
   Set oAttrib = m_XML_DOM.createAttribute("Line")
   oAttrib.Text = m_Line
   oNode.Attributes.setNamedItem oAttrib
   
   Set oAttrib = m_XML_DOM.createAttribute("Offset")
   oAttrib.Text = m_Offset
   oNode.Attributes.setNamedItem oAttrib
   
   Set oAttrib = m_XML_DOM.createAttribute("Length")
   oAttrib.Text = m_Length
   oNode.Attributes.setNamedItem oAttrib
   
   Set oAttrib = m_XML_DOM.createAttribute("ImgID")
   oAttrib.Text = m_ImgID
   oNode.Attributes.setNamedItem oAttrib
   
   Set oAttrib = m_XML_DOM.createAttribute("Address")
   oAttrib.Text = m_Address
   oNode.Attributes.setNamedItem oAttrib
   
   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("Markup/HyperLinks")
   
   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("Markup/HyperLinks")
   
   '
   ' 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").Text <> "" And .getNamedItem("Address").Text <> "" Then
               
               Dim strTemp         As String
               Dim strFileOnly     As String
               
               strTemp = .getNamedItem("Address").Text
               
               '
               ' 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").Text = strFileOnly
                   
                   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_UserLnkFile)) Then
       
       '
       ' seek to desired element
       '
       Dim oParent         As IXMLDOMNode
       
       Set oParent = m_XML_DOM.selectSingleNode("Markup/HyperLinks")
       
       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(szVDFFile, FullPath)

   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
0
 

Author Comment

by:slimbx
ID: 6274901
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
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6274922
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.
0
Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6274925
And thanks, I'm glad you like it  :)

Work with it some more and you'll see it becomes simpler!
0
 

Author Comment

by:slimbx
ID: 6274947
Last question, what exactly is the User.xib file for? Is it some sort of validation file (dtd or schema)?

Thanks

slimbx
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6277521
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.
0
 

Author Comment

by:slimbx
ID: 6277600
thats no problem then. thanks again.

slimbx
0
 
LVL 8

Accepted Solution

by:
Dave_Greene earned 35 total points
ID: 6277684
Welcome!
0

Featured Post

DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
XML Paring  Error - Premature end of file. 7 95
Problem to ToolkitScriptManager 2 59
Stupid git question 2 86
XML XSL Message 3 21
Browsing the questions asked to the Experts of this forum, you will be amazed to see how many times people are headaching about monster regular expressions (regex) to select that specific part of some HTML or XML file they want to extract. The examp…
What is Node.js? Node.js is a server side scripting language much like PHP or ASP but is used to implement the complete package of HTTP webserver and application framework. The difference is that Node.js’s execution engine is asynchronous and event…
Viewers will learn one way to get user input in Java. Introduce the Scanner object: Declare the variable that stores the user input: An example prompting the user for input: Methods you need to invoke in order to properly get  user input:
Viewers will learn about if statements in Java and their use The if statement: The condition required to create an if statement: Variations of if statements: An example using if statements:

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question