Attribute VB_Name = "INIMan" Option Explicit #If Win32 Then 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 String, ByVal lpString As Any, ByVal lpFileName As String) As Long Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long #End If Public Function getsetting(ByVal appname As String, ByVal section As String, ByVal key As String, Optional default) As String #If Win16 Then ' We can use VB's built-in GetSetting function, but we need to qualify it with the ' library for reasons of scope getsetting = VBA.getsetting(appname, section, key, default) Exit Function #ElseIf Win32 Then Dim Returned_String As String Dim return_value As Long ' Check the optional parameter and initialize it so we can pass it to ' an API function If IsMissing(default) Then default = "" End If ' Trim spaces from appname as this should be the name of a file appname = Trim$(appname) ' If there are no periods in appname then the filename has been supplied without an ' extension. Like Visual Basic's GetSetting function, we assume that we are dealing with ' files with ".ini" extensions, so we add this extension before passing the appname to GPPS. If (InStr(appname, ".") = False) Then appname = appname & ".ini" End If ' Initialize the variable so it's large enough to hold the returned value Returned_String = Space(255) On Error GoTo Err_Handler return_value = GetPrivateProfileString(section, key, default, Returned_String, LenB(Returned_String), App.Path & "\" & appname) ' Trim the variable and return the value getsetting = Left$(Returned_String, return_value) Exit Function Err_Handler: getsetting = default Exit Function #End If End Function Public Sub SaveSetting(ByVal appname As String, ByVal section As String, ByVal key As String, ByVal setting As String) #If Win16 Then ' We can use VB's built-in SaveSetting function, but we need to qualify it with the ' library for reasons of scope VBA.SaveSetting appname, section, key, setting Exit Sub #ElseIf Win32 Then Dim return_value As Long ' Trim spaces from appname as this should be the name of a file appname = Trim$(appname) ' If there are no periods in appname then the filename has been supplied without an ' extension. Like Visual Basic's SaveSetting statement, we assume that we are dealing with ' files with ".ini" extensions, so we add this extension before passing the appname to WPPS. If (InStr(appname, ".") = False) Then appname = appname & ".ini" End If ' Passing nulls to WPPS can cause parts of the INI file to be deleted. ' We don't wish to allow this here so we make a check to prevent this. If IsNull(appname) Or IsNull(section) Or IsNull(key) Then Err.Raise 94 'Invalid use of Null Exit Sub End If return_value = WritePrivateProfileString(section, key, setting, App.Path & "\" & appname) #End If End Sub Public Sub DeleteSetting(appname As String, section As String, Optional key) #If Win16 Then ' We can use VB's built-in DeleteSetting function, but we need to qualify it with the ' library for reasons of scope VBA.DeleteSetting appname, section, key Exit Sub #ElseIf Win32 Then Dim return_value As Long Dim setting As String ' Trim spaces from appname as this should be the name of a file appname = Trim$(appname) ' If there are no periods in appname then the filename has been supplied without an ' extension. Like Visual Basic's DeleteSetting statement, we assume that we are dealing with ' files with ".ini" extensions, so we add this extension before passing the appname to WPPS. If (InStr(appname, ".") = False) Then appname = appname & ".ini" End If ' Passing nulls to WPPS can cause parts of the INI file to be deleted. If IsMissing(key) Then ' This deletes the whole section return_value = WritePrivateProfileString(section, vbNullString, setting, App.Path & "\" & appname) Exit Sub Else ' This just deletes the specified key return_value = WritePrivateProfileString(section, key, vbNullString, App.Path & "\" & appname) Exit Sub End If #End If End Sub Public Function GetAllSettings(ByVal appname As String, ByVal section As String) #If Win16 Then GetAllSettings = VBA.GetAllSettings(appname, section) Exit Function #ElseIf Win32 Then Dim return_value As Long Dim Returned_String As String Dim null_position As Integer Dim equals_position As Integer Dim This_Entry As String Dim key_name As String Dim value As String Dim loop_counter As Integer Dim settings_array() As String Dim settings() As String ' Make the string variable large enough (10k) to hold the returned values Returned_String = Space(10240) ' Trim spaces from appname as this should be the name of a file appname = Trim$(appname) ' If there are no periods in appname then the filename has been supplied without an ' extension. Like Visual Basic's GetAllSettings function, we assume that we are dealing with ' files with ".ini" extensions, so we add this extension before passing the appname to WPPS. If (InStr(appname, ".") = False) Then appname = appname & ".ini" End If return_value = GetPrivateProfileSection(section, Returned_String, Len(Returned_String), appname) ' Trim the variable of trailing nulls Returned_String = Left$(Returned_String, return_value + 1) ' If there aren't still two trailing nulls then the variable is too small to hold all the settings If InStr(Returned_String, vbNullChar & vbNullChar) = False Then Err.Raise 1001, , "Danger! Huge INI file! Move to using the Registry immediately" Exit Function End If null_position = InStr(Returned_String, vbNullChar) Do This_Entry = Left$(Returned_String, null_position - 1) Returned_String = Right$(Returned_String, Len(Returned_String) - null_position) On Error GoTo err_Bad_Ini_File equals_position = InStr(This_Entry, "=") key_name = Left$(This_Entry, equals_position - 1) value = Right$(This_Entry, Len(This_Entry) - equals_position) ' We can only Redim Preserve on the last dimension of the array so we'll build ' it like this then invert it once we know how large it needs to be. ReDim Preserve settings_array(2, loop_counter) As String settings_array(0, loop_counter) = key_name settings_array(1, loop_counter) = value loop_counter = loop_counter + 1 null_position = InStr(Returned_String, vbNullChar) Loop Until Returned_String = Space(Len(Returned_String)) Or Returned_String = vbNullChar & Space(Len(Returned_String) - 1) ReDim settings(UBound(settings_array, 2), 1) As String For loop_counter = 0 To UBound(settings_array, 2) settings(loop_counter, 0) = settings_array(0, loop_counter) settings(loop_counter, 1) = settings_array(1, loop_counter) Next loop_counter GetAllSettings = settings() Exit Function err_Bad_Ini_File: Err.Raise 1002, , "This error is most probably due to a badly laid out INI file." _ & vbCrLf & vbTab & "INI files should be in the form:" _ & vbCrLf & vbTab & vbTab & "[Section]" _ & vbCrLf & vbTab & vbTab & "key = value" #End If End Function