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