读写INI文件的四个函数

　　


                  　　'文件名SourceDB.ini文件



　　Private Declare Function GetPrivateProfileString Lib "kernel32" Alias



　　"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal



　　lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal



　　lpFileName As String) As Long



　　Private Declare Function WritePrivateProfileString Lib "kernel32" Alias



　　"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal



　　lpString As Any, ByVal lpFileName As String) As Long



　　



　　'以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键



　　'仅仅针对是非值



　　'Y：yes,N：no,E：error



　　Public Function GetIniTF(ByVal In_Key As String) As Boolean



　　On Error GoTo GetIniTFErr



　　GetIniTF = True



　　Dim GetStr As String



　　GetStr = VBA.String(128, 0)



　　GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"



　　GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")



　　If GetStr = "1" Then



　　 GetIniTF = True



　　 GetStr = ""



　　Else



　　 GoTo GetIniTFErr



　　End If



　　Exit Function



　　GetIniTFErr:



　　 Err.Clear



　　 GetIniTF = False



　　 GetStr = ""



　　End Function



　　



　　Public Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean



　　On Error GoTo WriteIniTFErr



　　WriteIniTF = True



　　If In_Data = True Then



　　 WritePrivateProfileString "Setting", In_Key, "1", App.Path & "\SourceDB.ini"



　　Else



　　 WritePrivateProfileString "Setting", In_Key, "0", App.Path & "\SourceDB.ini"



　　End If



　　Exit Function



　　WriteIniTFErr:



　　 Err.Clear



　　 WriteIniTF = False



　　End Function


　　


                  





　　'以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键



　　'针对字符串值



　　'空值表示出错



　　Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String



　　On Error GoTo GetIniStrErr



　　If VBA.Trim(In_Key) = "" Then



　　 GoTo GetIniStrErr



　　End If



　　Dim GetStr As String



　　GetStr = VBA.String(128, 0)



　　 GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"



　　 GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")



　　If GetStr = "" Then



　　 GoTo GetIniStrErr



　　Else



　　 GetIniStr = GetStr



　　 GetStr = ""



　　End If



　　Exit Function



　　GetIniStrErr:



　　 Err.Clear



　　 GetIniStr = ""



　　 GetStr = ""



　　End Function



　　



　　Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean



　　On Error GoTo WriteIniStrErr



　　WriteIniStr = True



　　If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then



　　 GoTo WriteIniStrErr



　　Else



　　 WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "\SourceDB.ini"



　　End If



　　Exit Function



　　WriteIniStrErr:



　　 Err.Clear



　　 WriteIniStr = False



　　End Function