对Ini文件进行操作的类

Module IniWork Module IniWork

    Friend Class clsIniFileClass clsIniFile
        '模块名称 clsIniFile
        '功能描述 提供对Ini文件的一些操作
        '创建日期 20031026
        '开发机构 石家庄天海科技有限公司

        '声明API函数
        Private Declare Function WritePrivateProfileSection()Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
        Private Declare Function GetPrivateProfileString()Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
        Private Declare Function WritePrivateProfileString()Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
        Private objFilesys As Scripting.FileSystemObject  '文件系统对象
        Private fFileName As String '保存Ini文件名


        '过程名称：fGetIniString
        '功能描述：从ini文件中得到指定Section中的指定Key的值
        '接收参数：SectionName指定Section的名字,指定Key的名字
        '返回参数：返回读出的值
        '创建人员及日期：zzz@20031104
        Public Function fGetIniString()Function fGetIniString(ByVal sSectionName As String, _
                                      ByVal sKeyName As String, _
                                      ByVal IniFilePathName As String, _
                                      Optional ByVal sDefaultValue As String = "") As String

            Try
                If Not objFilesys.FileExists(IniFilePathName) Then '如果文件不存在则退出
                    fGetIniString = sDefaultValue
                    Exit Function
                End If

                Dim sValue As String
                sValue = Space(255)
                Dim i, iResult, iPos As Short

                iResult = GetPrivateProfileString(sSectionName, sKeyName, sDefaultValue, sValue, Len(sValue), IniFilePathName)
                iPos = InStr(1, sValue, Chr(0))
                If iPos > 0 Then '去掉未尾的chr(0)字符
                    fGetIniString = Mid(sValue, 1, iPos - 1)
                Else
                    fGetIniString = sValue
                End If
            Catch ex As Exception
                Throw New Exception("Error In fGetIniString!!!" & vbCrLf & _
                                    "Source:" & ex.Source.ToString() & "Message:" & ex.Message)
            End Try
        End Function


        '过程名称：sInitializeIniFile
        '功能描述：初始化ini文件对象，保存文件名字
        '接收参数：FullIniName要处理的ini文件名字(全路途文件名),bNoExistCreate如果文件不存是否创建
        '返回参数：
        '创建人员及日期：zzz@20031104
        Public Sub sInitializeIniFile()Sub sInitializeIniFile(ByVal FullIniName As String, Optional ByVal bNoExistCreate As Boolean = True)
            Try
                If Not objFilesys.FileExists(FullIniName) And bNoExistCreate Then '如果文件不存在并且需要创建则创建
                    WritePrivateProfileSection("Created Date", "Created=" & Today & " " & TimeOfDay & Chr(0) & Chr(0), FullIniName)
                End If
                fFileName = FullIniName
            Catch ex As Exception
                Throw New Exception("Error In sInitializeIniFile!!!" & vbCrLf & _
                                        "Source:" & ex.Source.ToString() & "Message:" & ex.Message)
            End Try
        End Sub


        '过程名称：fWriteIniSection
        '功能描述：将包含多个key及key值的数组写入ini文件中的指定Section
        '接收参数：SectionName指定要写入的Section,FieldArr表示key及key值的字符串如
        '          FieldArr(0) = "a=0"    FieldArr(0) = "b=1",如果Section不存在则创建
        '返回参数：成功返回True,否则返回False
        '创建人员及日期：zzz@20031104
        Public Function fWriteIniSection()Function fWriteIniSection(ByVal SectionName As String, Optional ByRef FieldArr As Object = Nothing) As Boolean
            Try
                Dim iResult As Short
                If Not objFilesys.FileExists(fFileName) Then
                    fWriteIniSection = False
                    Exit Function
                End If
                '
                Dim sTemp As String
                sTemp = ""

                Dim i As Short
                If Not IsNothing(FieldArr) Then
                    For i = LBound(FieldArr) To UBound(FieldArr)
                        sTemp = sTemp + FieldArr(i) & Chr(0)
                    Next
                End If

                sTemp = sTemp & Chr(0)
                iResult = WritePrivateProfileSection(SectionName, sTemp, fFileName)
                fWriteIniSection = iResult <> 0
            Catch ex As Exception
                Throw New Exception("Error In fWriteIniSection!!!" & vbCrLf & _
                                        "Source:" & ex.Source.ToString() & "Message:" & ex.Message)
            End Try
        End Function


        '过程名称：fWriteIniString
        '功能描述：将单个key及key值写入ini文件中的指定Section
        '接收参数：SectionName指定要写入的Section,KeyName表示key的名字,KeyValue表示key的值
        '返回参数：成功返回True,否则返回False
        '创建人员及日期：zzz@20031104
        Public Function fWriteIniString()Function fWriteIniString(ByVal SectionName As String, _
                                        ByVal KeyName As String, _
                                        ByVal KeyValue As String, _
                                        ByVal IniFilePathName As String) As Boolean
            Try
                Dim iResult As Short
                If Not objFilesys.FileExists(IniFilePathName) Then '文件不存在则退出
                    fWriteIniString = False
                    Exit Function
                End If

                iResult = WritePrivateProfileString(SectionName, KeyName, KeyValue, IniFilePathName)
                fWriteIniString = iResult <> 0
            Catch ex As Exception
                Throw New Exception("Error In fWriteIniString!!!" & vbCrLf & _
                                        "Source:" & ex.Source.ToString() & "Message:" & ex.Message)
            End Try
        End Function

        Private Sub Class_Initialize_Renamed()Sub Class_Initialize_Renamed()
            Try
                objFilesys = New Scripting.FileSystemObject
            Catch ex As Exception
                Throw New Exception("Error In Class_Initialize_Renamed!!!" & vbCrLf & _
                                        "Source:" & ex.Source.ToString() & "Message:" & ex.Message)
            End Try
        End Sub
        Public Sub New()Sub New()
            MyBase.New()
            Class_Initialize_Renamed()
        End Sub

        Private Sub Class_Terminate_Renamed()Sub Class_Terminate_Renamed()
            Try
                objFilesys = Nothing
            Catch ex As Exception
                Throw New Exception("Error In Class_Terminate_Renamed!!!" & vbCrLf & _
                                           "Source:" & ex.Source.ToString() & "Message:" & ex.Message)
            End Try
        End Sub
        Protected Overrides Sub Finalize()Sub Finalize()
            Class_Terminate_Renamed()
            MyBase.Finalize()
        End Sub
    End Class
End Module