'文件名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 LongPrivate 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：errorPublic Function GetIniTF(ByVal In_Key As String) As BooleanOn Error GoTo GetIniTFErrGetIniTF = TrueDim GetStr As StringGetStr = 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 GetIniTFErrEnd IfExit FunctionGetIniTFErr: Err.Clear GetIniTF = False GetStr = ""End Function
Public Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As BooleanOn Error GoTo WriteIniTFErrWriteIniTF = TrueIf In_Data = True Then WritePrivateProfileString "Setting", In_Key, "1", App.Path & "/SourceDB.ini"Else WritePrivateProfileString "Setting", In_Key, "0", App.Path & "/SourceDB.ini"End IfExit FunctionWriteIniTFErr: Err.Clear WriteIniTF = FalseEnd Function
'以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键'针对字符串值'空值表示出错Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As StringOn Error GoTo GetIniStrErrIf VBA.Trim(In_Key) = "" Then GoTo GetIniStrErrEnd IfDim GetStr As StringGetStr = 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 GetIniStrErrElse GetIniStr = GetStr GetStr = ""End IfExit FunctionGetIniStrErr: Err.Clear GetIniStr = "" GetStr = ""End Function
Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As BooleanOn Error GoTo WriteIniStrErrWriteIniStr = TrueIf VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then GoTo WriteIniStrErrElse WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "/SourceDB.ini"End IfExit FunctionWriteIniStrErr: Err.Clear WriteIniStr = FalseEnd Function
