VB读取xml处理类

精选转载

yygll123 2011-12-01 06:07:12

Option Explicit
Option Compare Text
DefInt I
DefStr S
DefDate D
DefLng L
DefBool B

Dim mvarsXmlFile As String                       'xmlFile属性内存变量
Dim mvarsXmlContent As String                    'xmlContent属性内存变量
Dim mvarsXmlRoot As MSXML2.DOMDocument           'xmlRoot属性内存变量
Public Property Let XmlRoot(ByRef vData As MSXML2.DOMDocument)
   Set mvarsXmlRoot = vData
End Property
Public Property Get XmlRoot() As MSXML2.DOMDocument
   Set XmlRoot = mvarsXmlRoot
End Property

Public Property Let XmlFile(ByVal vData As String)
    mvarsXmlFile = vData
End Property
Public Property Get XmlFile() As String
    XmlFile = mvarsXmlFile
End Property

Public Property Let XmlContent(ByVal vData As String)
    mvarsXmlContent = vData
End Property
Public Property Get XmlContent() As String
    XmlContent = mvarsXmlContent
End Property

'类初始化
Private Sub Class_Initialize()

Me.XmlContent = ""
Me.XmlFile = ""
'Me.XmlRoot = New MSXML2.DOMDocument
Set mvarsXmlRoot = New MSXML2.DOMDocument
End Sub
'Private Sub Class_Terminate()
'   XmlRoot.abort
'
'End Sub

Function fun_XmlLoad(ByVal sFilePath As String) As Boolean
On Error GoTo Morn
fun_XmlLoad = False
If Dir(sFilePath, vbNormal) = "" Then Exit Function

Me.XmlRoot.Load sFilePath
Me.XmlFile = Trim(sFilePath)
Do While XmlRoot.readyState <> 4
   DoEvents
Loop
Me.XmlFile = XmlRoot.XML
fun_XmlLoad = True
Exit Function
Morn:

End Function
'找到节点对象
Function fun_GetElement(ByVal sItem As String) As MSXML2.IXMLDOMElement
'Set fun_GetElement = New ms

On Error GoTo Morn
Set fun_GetElement = Me.XmlRoot.selectSingleNode(sItem)
Exit Function
Morn:

End Function
'读取节点text函数
Function fun_GetElementText(ByVal sItem As String) As String
Dim oElement As MSXML2.IXMLDOMElement
fun_GetElementText = ""
On Error GoTo Morn
Set oElement = Me.XmlRoot.selectSingleNode(sItem)
If oElement Is Nothing Then Exit Function
fun_GetElementText = oElement.Text
Exit Function
Morn:

End Function
'读取节点属性值函数，默认读取value属性值
Function fun_GetProperty(ByVal sItem As String, Optional ByVal sPropertyName = "value") As String
Dim oElement As MSXML2.IXMLDOMElement
fun_GetProperty = ""
On Error GoTo Morn
Set oElement = Me.XmlRoot.selectSingleNode(sItem)
Set oElement = Me.XmlRoot.selectSingleNode(sItem)
If oElement Is Nothing Then Exit Function
fun_GetProperty = oElement.getAttribute(sPropertyName)
Exit Function
Morn:
End Function