'文件名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