frmmain.frm

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

'               class object
'****************************************************************************************
Option Explicit

'****************************************************************************************
'API CONSTANTS
'****************************************************************************************
Private Const SW_SHOW As Long = 5

'****************************************************************************************
'API FUNCTIONS
'****************************************************************************************
Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
                ByVal hwnd As Long, _
                ByVal lpOperation As String, _
                ByVal lpFile As String, _
                ByVal lpParameters As String, _
                ByVal lpDirectory As String, _
                ByVal nShowCmd As Long) _
                As Long

'****************************************************************************************
'CONSTANTS - PRIVATE
'****************************************************************************************
Private Const cdOpenFilter As String = "INI Files (*.ini)|*.ini|XML Files (*.xml)|*.xml|All Files (*.*)|*.*"
Private Const cdSaveFilter As String = "XML Files (*.xml)|*.xml|All Files (*.*)|*.*"

'****************************************************************************************
'VARIABLES - PRIVATE
'****************************************************************************************
Private mcXML As New XMLConfig
Private msFilename As String

'****************************************************************************************
'EVENTS - PRIVATE
'****************************************************************************************
Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdDelKey_Click()
    'provide a way to delete a key
    Dim eRet As VbMsgBoxResult
    eRet = MsgBox("Are you sure you want to delete this key?", vbYesNo)
    If eRet = vbYes Then
        mcXML.Section = txtSection.Text
        mcXML.Key = txtKey.Text
        mcXML.DeleteKey
        RefreshList
    End If
End Sub

Private Sub cmdView_Click()
    mnuFile_Click 3
End Sub

Private Sub cmdWrite_Click()
    
    'there must be a key name
    If txtKey.Text = vbNullString Then
        MsgBox "You must enter a Key name before attempting to write"
        txtKey.SetFocus
        Exit Sub
    End If
    
    'there must be a section name
    If txtSection.Text = vbNullString Then
        MsgBox "You must enter a Section name before attempting to write"
        txtSection.SetFocus
        Exit Sub
    End If
    
    'make sure we have a valid filename before attempting to write
    If msFilename = vbNullString Then
        mnuFile_Click 1
        If msFilename = vbNullString Then
            Exit Sub
        End If
        mcXML.Path = msFilename
    End If
    
    'now set the properties and refresh the list
    With mcXML
        .Section = txtSection.Text
        .SectionDescription = txtSectDesc.Text
        .Key = txtKey.Text
        .KeyDescription = txtKeyDesc.Text
        .Value = txtValue.Text
    End With
    
End Sub

Private Sub cmdDelSection_Click()
    'provide a way to delete a section
    Dim eRet As VbMsgBoxResult
    eRet = MsgBox("Are you sure you want to delete this section?", vbYesNo)
    If eRet = vbYes Then
        mcXML.Section = txtSection.Text
        mcXML.DeleteSection
        RefreshList
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Set mcXML = Nothing
End Sub

Private Sub mnuFile_Click(Index As Integer)
    On Error GoTo ErrHandler
    Dim sFile As String
    Dim sXMLFile As String
    
    'set properties for common dialog
    With cdlFile
        .CancelError = True
        .Flags = cdlOFNHideReadOnly + cdlOFNOverwritePrompt
    End With
    
    Select Case Index
        Case 0  'Open
            With cdlFile
                .Filter = cdOpenFilter
                .FilterIndex = 2
                .ShowOpen
                sFile = .FileName
            End With
            'if the file is an INI file convert to XML
            If LCase$(Right$(sFile, 3)) = "ini" Then
                'this will be same filename with ".xml" extension
                'ie. sample.ini becomes sample.ini.xml
                mcXML.IniToXml sFile, sXMLFile
                msFilename = sXMLFile
            Else
                msFilename = sFile
            End If
            RefreshList
        Case 1  'Save As
            With cdlFile
                .Filter = cdSaveFilter
                .FilterIndex = 1
                .ShowSave
                sFile = .FileName
            End With
            If msFilename <> vbNullString Then
                'have a current filename but save it as a new filename
                FileCopy msFilename, sFile
            Else
                'we do not have a current file so first we need to kill the old
                Kill sFile
            End If
            msFilename = sFile
        Case 3  'View
            ShellExecute 0, "open", msFilename, vbNullString, vbNullString, SW_SHOW
        Case 5  'Exit
            Unload Me
    End Select
    If msFilename <> vbNullString Then
        mnuFile(1).Enabled = True
        mnuFile(3).Enabled = True
        cmdDelSection.Enabled = True
        cmdDelKey.Enabled = True
        cmdView.Enabled = True
    End If
    Exit Sub
ErrHandler:
    If Err.Number <> 32755 Then
        If Err.Number = 53 Then
            Resume Next
        End If
        'user did not cancel
        Debug.Print Err.Number & ": " & Err.Description
    End If
End Sub

Private Sub mnuHelp_Click(Index As Integer)
    Select Case Index
        Case 0
            MsgBox "INI XML Editor was written by Jim Kahl"
        Case 1
            ShellExecute 0, "open", App.Path & "\readme.doc", vbNullString, vbNullString, SW_SHOW
    End Select
End Sub

Private Sub tvwSettings_Click()
    On Error Resume Next
    With mcXML
        If tvwSettings.Nodes(tvwSettings.SelectedItem.Text).Children = 0 Then
            'this is for when someone clicks the key name
            .Section = tvwSettings.SelectedItem.Parent.Text
            .Key = tvwSettings.SelectedItem.Text
            txtSection.Text = .Section
            txtSectDesc.Text = .SectionDescription
            txtKey.Text = .Key
            txtKeyDesc.Text = .KeyDescription
            txtValue.Text = .Value
        Else
            'this is for when someone clicks just a section name
            .Section = tvwSettings.SelectedItem.Text
            txtSection.Text = .Section
            txtSectDesc.Text = .SectionDescription
            txtKey.Text = vbNullString
            txtKeyDesc.Text = vbNullString
            txtValue.Text = vbNullString
        End If
    End With
End Sub

'****************************************************************************************
'METHODS - PRIVATE
'****************************************************************************************
Private Sub RefreshList()
    Dim sSection() As String
    Dim sKey() As String
    Dim lCount As Long
    Dim lSection As Long
    Dim lKey As Long
    
    On Error GoTo ErrHandler
    
    tvwSettings.Nodes.Clear
    
    'fill the tree view with the Section and Key nodes from the XML file
    With mcXML
        .Path = msFilename
        'EnumerateAllSections will error out if this is a new file or if
        'the file does not contain any Sections - that is ok for now, it
        'just means there is nothing at this time to populate the treeview
        .EnumerateAllSections sSection(), lCount
        For lSection = LBound(sSection) To UBound(sSection)
            tvwSettings.Nodes.Add , , sSection(lSection), sSection(lSection)
            .Section = sSection(lSection)
            'EnumerateCurrentSection will error out if the Section does not
            'have any Keys associated with it, but that's ok since we want to
            'be able to add and delete keys at will
            .EnumerateCurrentSection sKey(), lCount
            For lKey = LBound(sKey) To UBound(sKey)
                .Key = sKey(lKey)
                tvwSettings.Nodes.Add sSection(lSection), tvwChild, , sKey(lKey)
            Next lKey
            tvwSettings.Nodes(sSection(lSection)).Expanded = True
        Next lSection
    End With
    tvwSettings.Nodes(1).Selected = True
    tvwSettings_Click
ErrHandler:
'    Debug.Print Err.Number & ": " & Err.Description
End Sub