xmlconfig.cls

INI_to_XML,XML文件操作,VB源程序.想学习XML编程的朋友可以下载试试.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "XMLConfig"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'****************************************************************************************
'Module:        mCONFIG - Class Module
'Filename:      mCONFIG.cls
'Author:        Jim Kahl
'Based On:      code in this class is based on two applications
'               cINIFile by Steve McMahon www.vbaccelerator.com
'
'               [[ a ini file to XML converter by Pamela RAI
'               www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=48510&lngWId=1
'               this code uses a modified version of that xml format
'
'Purpose:       to be able to read/write settings to an XML file the same way that you
'               can read/write to an INI file
'Instancing:    5 - Multiuse
'Depends:       Microsoft XML, v2.6 or later - this references v2.6 but has also been
'               tested with v6 and no problems
'
'Assumes:       if you are attempting to open an existing XML file it must be in the
'               correct format - see sample.ini.xml in Related Documents for the utility
'               project for the format used
'
'NOTE:          this was written so that it could almost be a direct drop in replacement
'               of Steve McMahon's cINIFile.cls with some omissions/additions on my part
'****************************************************************************************
Option Explicit

'****************************************************************************************
'API FUNCTIONS
'****************************************************************************************
Private Declare Function GetPrivateProfileSection Lib "kernel32.dll" _
        Alias "GetPrivateProfileSectionA" ( _
                ByVal lpAppName As String, _
                ByVal lpReturnedString As String, _
                ByVal nSize As Long, _
                ByVal lpFileName As String) _
                As Long
                
Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" _
        Alias "GetPrivateProfileSectionNamesA" ( _
                ByVal lpszReturnBuffer As String, _
                ByVal nSize As Long, _
                ByVal lpFileName As String) _
                As Long

'****************************************************************************************
'CONSTANTS - PRIVATE
'****************************************************************************************
Private Const INITIAL_BUFFER_SIZE As Long = 1024
Private Const mCONFIG As String = "Configuration"
Private Const mSECTION As String = "Section"
Private Const mBLOCK As String = mCONFIG & "/" & mSECTION
Private Const mKEY As String = "Setting"
Private Const mAttrName As String = "Name"
Private Const mAttrValue As String = "Value"
Private Const mAttrDesc As String = "Description"
Private Const mAttrNameID As Long = 0
Private Const mAttrValueID As Long = 1
Private Const mAttrDescID As Long = 2

'****************************************************************************************
'VARIABLES - PRIVATE
'****************************************************************************************
Private msFilename As String
Private msSection As String
Private msKey As String
Private moDoc As New MSXML2.DOMDocument

'****************************************************************************************
'PROPERTIES - PUBLIC READ/WRITE
'****************************************************************************************
'Path - sets/returns the fully qualified path and filename of the xml file
Public Property Get Path() As String
    Path = msFilename
End Property

Public Property Let Path(ByRef sFilename As String)
    msFilename = sFilename
    moDoc.Load sFilename
End Property

'*******************************************
'Section - sets/returns the section of the XML file
Public Property Get Section() As String
    Section = msSection
End Property

Public Property Let Section(ByRef sSection As String)
    msSection = sSection
End Property

'*******************************************
'Key - sets/returns the key within a section of the XML file
Public Property Get Key() As String
    Key = msKey
End Property

Public Property Let Key(ByRef sKey As String)
    msKey = sKey
End Property

'*******************************************
'Value - sets/returns the value of a specific key within a section
Public Property Get Value() As String
    On Error GoTo ErrHandler
    Dim oBlock As MSXML2.IXMLDOMNode
    Dim oBlocks As MSXML2.IXMLDOMNodeList
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oNodes As MSXML2.IXMLDOMNodeList
    
    Set oBlocks = moDoc.selectNodes(mBLOCK)

    For Each oBlock In oBlocks
        If oBlock.Attributes(mAttrNameID).Text = msSection Then
            Set oNodes = oBlock.childNodes

            If oNodes.length <> 0 Then
                For Each oNode In oNodes
                    If oNode.Attributes(mAttrNameID).Text = msKey Then
                        Value = oNode.Attributes(mAttrValueID).Text
                        Exit Property
                    End If
                Next oNode
            End If
            Exit For
        End If
    Next oBlock

ExitProc:
    Exit Property
ErrHandler:
    Resume ExitProc
End Property

Public Property Let Value(ByRef sValue As String)
    'Note:   if the section and/or key do not exist this routine will call routines
    '        to create them
    On Error GoTo ErrHandler
    
    Dim oBlock As MSXML2.IXMLDOMNode
    Dim oBlocks As MSXML2.IXMLDOMNodeList
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oNodes As MSXML2.IXMLDOMNodeList
    Dim oNodeChild As MSXML2.IXMLDOMNode
    Dim oAttr As MSXML2.IXMLDOMNode
    
    'make sure the document has the Configure node and at least one Section
    'before attempting to write
    Set oBlocks = moDoc.selectNodes(mCONFIG)

    If oBlocks.length = 0 Then
        CreateConfigure
    End If
    
    Set oBlocks = moDoc.selectNodes(mBLOCK)
    
    If oBlocks.length = 0 Then
        CreateSection
        Value = sValue
    End If
    
    'iterate through the blocks until we find the correct section and key
    For Each oBlock In oBlocks
        If oBlock.Attributes(mAttrNameID).Text = msSection Then
            Set oNodes = oBlock.childNodes

            If oNodes.length <> 0 Then
                For Each oNode In oNodes
                    If oNode.Attributes(mAttrNameID).Text = msKey Then
                        'set the key value and save the file
                        oNode.Attributes(mAttrValueID).Text = sValue
                        moDoc.save msFilename
                        Exit Property
                    End If
                Next oNode
                
                'if we reach this point then the section exists but the key does not
                'so we create the new key and value pair
                CreateKeyValue oBlock, sValue
                moDoc.save msFilename
                Exit Property
            End If
            Exit For
        End If
    Next oBlock
    
ExitProc:
    Exit Property
ErrHandler:
    Debug.Print Err.Description
    Resume ExitProc
End Property

'*******************************************
'KeyDescription - sets/returns the descriptive comment for a key/value pair
'NOTE:  this is mainly used for documentation purposes
Public Property Get KeyDescription() As String
    'Returns:       if the key does not exist will return ""
    '               Otherwise will return the contents of the attribute
    On Error GoTo ErrHandler
    Dim oBlock As MSXML2.IXMLDOMNode
    Dim oBlocks As MSXML2.IXMLDOMNodeList
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oNodes As MSXML2.IXMLDOMNodeList
    
    Set oBlocks = moDoc.selectNodes(mBLOCK)

    For Each oBlock In oBlocks
        If oBlock.Attributes(mAttrNameID).Text = msSection Then
            Set oNodes = oBlock.childNodes

            If oNodes.length <> 0 Then
                For Each oNode In oNodes
                    If oNode.Attributes(mAttrNameID).Text = msKey Then
                        KeyDescription = oNode.Attributes(mAttrDescID).Text
                        Exit Property
                    End If
                Next oNode
            End If
            Exit For
        End If
    Next oBlock

ExitProc:
    Exit Property
ErrHandler:
    Resume ExitProc
End Property

Public Property Let KeyDescription(sValue As String)
    'Note:   if the section and/or key do not exist this routine will call routines
    '        to create them
    On Error GoTo ErrHandler
    
    Dim oBlock As MSXML2.IXMLDOMNode
    Dim oBlocks As MSXML2.IXMLDOMNodeList
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oNodes As MSXML2.IXMLDOMNodeList
    Dim oNodeChild As MSXML2.IXMLDOMNode
    Dim oAttr As MSXML2.IXMLDOMNode
    
    'setup the document for access
    Set oBlocks = moDoc.selectNodes(mCONFIG)

    If oBlocks.length = 0 Then
        CreateConfigure
    End If
    
    Set oBlocks = moDoc.selectNodes(mBLOCK)
    
    If oBlocks.length = 0 Then
        CreateSection
        KeyDescription = sValue
    End If
    
    'iterate through the blocks until we find the correct section and key
    For Each oBlock In oBlocks
        If oBlock.Attributes(mAttrNameID).Text = msSection Then
            Set oNodes = oBlock.childNodes

            If oNodes.length <> 0 Then
                For Each oNode In oNodes
                    If oNode.Attributes(mAttrNameID).Text = msKey Then
                        'set the description value and save the file
                        oNode.Attributes(mAttrDescID).Text = sValue
                        moDoc.save msFilename
                        Exit Property
                    End If
                Next oNode
            Else
                'if we reach this point then the section exists but the key does not
                'so we create the new key and value pair
                CreateKeyValue oBlock, , sValue
                moDoc.save msFilename
                Exit Property
            End If
            Exit For
        End If
    Next oBlock
    
ExitProc:
    Exit Property
ErrHandler:
    Debug.Print Err.Description
    Resume ExitProc
End Property

'*******************************************
'SectionDescription - sets/returns the descriptive comment for a section
'NOTE:  this is mainly used for documentation purposes
Public Property Get SectionDescription() As String
    'Returns:       if the section does not exist will return ""
    '               Otherwise will return the contents of the attribute
    On Error GoTo ErrHandler
    Dim oBlock As MSXML2.IXMLDOMNode
    Dim oBlocks As MSXML2.IXMLDOMNodeList
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oNodes As MSXML2.IXMLDOMNodeList
    
    Set oBlocks = moDoc.selectNodes(mBLOCK)

    For Each oBlock In oBlocks
        If oBlock.Attributes(mAttrNameID).Text = msSection Then
            SectionDescription = oBlock.Attributes(mAttrValueID).Text
            Exit Property
        End If
    Next oBlock

ExitProc:
    Exit Property
ErrHandler:
    Resume ExitProc
End Property

Public Property Let SectionDescription(sValue As String)
    'Note:   if the section does not exist this routine will call the routine to create it
    On Error GoTo ErrHandler
    
    Dim oBlock As MSXML2.IXMLDOMNode
    Dim oBlocks As MSXML2.IXMLDOMNodeList
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oNodes As MSXML2.IXMLDOMNodeList
    Dim oNodeChild As MSXML2.IXMLDOMNode
    Dim oAttr As MSXML2.IXMLDOMNode