Attribute VB_Name = "modIni"
Option Explicit
DefInt A-Z
'******************************
'Ini Functions
'******************************
'--------------------------------------
'Copyright 1997 - NEWMAN Services Corp.
'No portion may be copied for profit
'without the author's agreement.
'--------------------------------------

Public IniFileNameDefault As String
Public IniOnBlankRaiseError As Boolean

'INI OVERVIEW
'   Ini - pronounced innie like a belly button;
'       aka: Configuration Settings File
'   Ini files were used before the Registry came along with 95 & NT.
'   I still prefer to use Ini files since I can just delete them.
'   I rarely use any of these procedures I've written here
'   other than the Ini property.
'   I never even enter an Ini file name.
'   These procedures will pick a nice one for me.
'   If you want to pick the Ini file name,
'   be sure you understand the difference between
'   the IniFileNameDefault property and the FileName arguments.
'   Basicly, if you set IniFileNameDefault to the name of an INI file,
'   these procedures will use that file.
'   If you fill in a FileName argument,
'   it will not change the value of IniFileNameDefault.
'   The FileName areguments are provided just as a way of
'   temporarilly overriding IniFileNameDefault.
'   See the IniFileNameDefault property documentation for more info.

'Ini & IniFile dynamic properties
'   Returns or sets the value associated
'   with the given label & section.
'   If Ini is used instead of IniFile,
'   then IniFileNameDefault is used as the file name.
'   There is no function to remove labels added
'   beyond setting the label's value to blank
'   or calling IniDeleteSection.
'   EXAMPLES
'       Value$ = Ini(Section$, Label$)
'       Ini(Section$, Label$) = Value$
'       Value$ = IniFile(Section$, Label$, FileName$)
'       IniFile(Section$, Label$, FileName$) = Value$

'The following are documented in the procedure:
'   IsTrue function, IniLabels function,
'   IniSection function, IniDeleteSection command.

'IniOnBlankRaiseError static property
'   This simplefies catching the problem
'   of misspelling label and section names.
'   If IniOnBlankRaiseError is True and
'   any procedure finds only blanks,
'   then an error is raised.
'   IniOnBlankRaiseError is False by default.
'EXAMPLE
'   Dim Min As Long, Max As Long
'   IniOnBlankRaiseError = True
'   On Error Goto Trap
'   Min = val(Ini("Limits", "Man"))
'   Max = val(Ini("Limits", "Mix"))
'   Exit Sub
'   Trap:
'   MsgBox Err.Description & " (" & Err.Number & ")"

'IniFileNameDefault static property
'   Returns or sets the default file name.
'   If a procedure is used without the FileName argument,
'   then IniFileNameDefault is used.
'   If IniFileNameDefault is blank,
'   then it gets set to a name chosen by the system.
'
'   ******   HOW A DEFAULT FILE NAME IS CHOSEN   ******
'   The default file gets the same name as
'   the executible except with the extention INI.
'   The search is something like the Windows Path Search Order.
    '1 - App.Path
    '2 - Current Directory
    '3 - Windows Directory (GetWindowsDirectory API)
    '    (Widows System Directory is skipped)
    '4 - Directories in the PATH environment variable.
'   First, it tries to find a file with that name.
'   Write access is prefered.
'   But if one is not found,
'   then the next step depends on the Ini procedure call.
'   If write access is not needed and a file with read access was found,
'   then that path is used.
'   Otherwise, a file creation is attempted using the Search Order.
'   Finally, if nothing works, IniFileNameDefault is left blank
'   which will eventually cause an appropriate error.

'******************************
'The rest is all private.
'******************************
Private Const FIX_LENGTH% = 4096

'The following can be seen outside of this module
'but probably shouldn't be used.
#If Win32 Then ' 32-bit VB uses this Declare.
    Private Declare Function IniGetApi 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 IniWriteApi Lib "kernel32" _
        Alias "WritePrivateProfileStringA" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpString As Any, ByVal lpFileName As String) As Long
    Private Declare Function WinDirApi Lib "kernel32" _
        Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long

#Else   ' 16-bit VB uses this Declare.
    Private Declare Function IniGetApi Lib "Kernel" _
        Alias "GetPrivateProfileString" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpDefault As String, ByVal lpReturnedString As String, _
        ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function IniWriteApi Lib "Kernel" _
        Alias "WritePrivateProfileString" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpString As Any, ByVal lplFileName As String) As Integer
    Private Declare Function WinDirApi Lib "Kernel" _
        Alias "GetWindowsDirectory" _
        (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
#End If

Private Function zWinDir() As String
    'You might find this same function coded in other modules.
    'It is coded separatelly here to make this module more reusable.
    'called privatelly by zFindIniFileName.

    'WinDir
    '   Path$ = WinDir()
    '   Returns the path of the current windows directory.
    
    Const FIX_LENGTH% = 4096
    Dim Length As Long
    Dim Buffer As String * FIX_LENGTH

    Length = WinDirApi(Buffer, FIX_LENGTH - 1)
    zWinDir = Left$(Buffer, Length)
End Function

Function IniSection(ByVal Section As String, _
    Optional ByVal FileName As Variant) As Collection
    
    '-----------------------------
    'Set colValues = IniSection(Section$, FileName$)
    'Returns a collection of values
    'that are in the given section and file name.
    'FileName is optional.
    'If FileName is not filled in,
    'then IniFileNameDefault is used.
    'If the section does not exist or is empty,
    'then the result is set to Nothing.
    'This is like IniLabels except that the label
    'names are used as the keys in the collection.
    'Instead of an numeric index,
    'you can use a label name as the key to get a value.
    'EXAMPLE
    '    Dim colValues As Collection
    '    Dim Label As String
    '    Set colValues = IniLabels(Section$, FileName$)
    '    Label = InputBox("Enter a label name.")
    '    MsgBox "The value of " & Label & " is " colValues(Label)
    '-----------------------------

    Dim Label As Variant
    Dim colLabels As Collection
    Dim colValues As New Collection

    If IsMissing(FileName) Then
        Call zFindIniFileName(Section)
        FileName = IniFileNameDefault
    End If

    Set colLabels = IniLabels(Section, FileName)
    If colLabels.Count = 0 Then
        Set IniSection = colValues
        Exit Function
    End If
    
    For Each Label In colLabels
        colValues.Add IniFile(Section, Label, FileName), Label
    Next Label
    
    Set IniSection = colValues
End Function

Function IniLabels(ByVal Section As String, _
    Optional ByVal FileName As Variant) As Collection
    
    '---------------------------------------------
    'Set colLabels = IniFileLabels(Section$, FileName$)
    'Returns a collection of label names
    'that are in the given section and file name.
    'FileName is optional.
    'If FileName is not filled in,
    'then IniFileNameDefault is used.
    'If the section does not exist or is empty,
    'then the result is set to Nothing.
    'EXAMPLE
    '    Dim colLabels As Collection
    '    Dim Label As Variant
    '    Set colLabels = IniLabels(Section$, FileName$)
    '    lstLabels.Clear
    '    For Each Label In colLabels
    '        lstLabels.AddItem Label
    '    Next Label
    '---------------------------------------------

    Dim Buffer As String * FIX_LENGTH
    Dim Length As Long
    Dim Pos As Long
    Dim LastPos As Long
    Dim colLabels As New Collection
    Dim Msg As String

    If IsMissing(FileName) Then
        Call zFindIniFileName(Section)
        FileName = IniFileNameDefault
    End If

    Length = IniGetApi(Section, ByVal 0&, "", Buffer, FIX_LENGTH - 1, FileName)
    If Length >= FIX_LENGTH - 1 Then
        Err.Raise 9997, , "All the labels together are too long"
    ElseIf Length = 0 Then
        If IniOnBlankRaiseError Then
            Msg = "Section " & Section & " of " & FileName & " is empty."
            Err.Raise 9995, , Msg
        Else
            Set IniLabels = colLabels
            Exit Function
        End If
    End If

    Do
        LastPos = Pos
        Pos = InStr(LastPos + 1, Buffer, Chr$(0))
        colLabels.Add Mid$(Buffer, LastPos + 1, Pos - LastPos - 1)
    Loop Until Pos = Length
    Set IniLabels = colLabels
End Function

Public Function IsTrue(ByVal Text As String) As Boolean
    'If IsFrue(Ini(Section$, Label$)) then ...
    'IsTrue provides an easy way to check for a boolean value.
    'If the value resemples anything in the afermitive
    '(1, -1, T, True, Y, Yes, On), then True is returned.
    'Otherwise, False is returned.
    'False values should look like 0, F, False, N, No, or Off.
    Text = Trim$(UCase$(Text))
    If Text = "" Then
        IsTrue = False
    ElseIf InStr("TRUE", Text) = 1 Then
        IsTrue = True
    ElseIf InStr("FALSE", Text) = 1 Then
        IsTrue = False
    ElseIf InStr("YES", Text) = 1 Then
        IsTrue = True
    ElseIf InStr("NO", Text) = 1 Then
        IsTrue = False
    ElseIf Text = "ON" Then
        IsTrue = True
    ElseIf Text = "OFF" Then
        IsTrue = False
    Else
        IsTrue = Val(Text)
    End If
End Function

Sub IniDeleteSection(ByVal Section As String, _
    Optional ByVal FileName As Variant)
    
    '---------------------------------
    'Call IniDeleteSection(Section$, FileName$)
    'Deletes the given section including
    'all of its labels and values.
    'FileName is optional.
    'If FileName is not filled in,
    'then IniFileNameDefault is used.
    'There's no way to delete individual labels
    'beyond setting their values to blank.
    '---------------------------------
    
    If IsMissing(FileName) Then
        Call zFindIniFileName(Section)
        FileName = IniFileNameDefault
    End If
    
    If IniWriteApi(Section, 0&, 0&, FileName) = 0 Then
        Err.Raise 9998, , "Unsuccessful deleting section in INI file"
    End If
End Sub

Private Function zFindDirIsReadWrite(ByVal TryFileName As String) As Boolean
    'Called by zFindIniFileName.
    Dim hFile As Long

    On Error GoTo zFindDirIsReadWriteTrap
    hFile = FreeFile
    Open TryFileName For Append As hFile
    Close hFile
    IniFileNameDefault = TryFileName
    'If we get this far without an error then we got what we want.
    'Otherwise, we should keep looking.
    zFindDirIsReadWrite = True
zFindDirIsReadWriteTrap:
    Exit Function
End Function

Private Sub zFindIniFileName(ByVal Section As String)
    'The Windows Path Search Order is (even in Windows95):
    '1 - App.Path
    '2 - Current Directory
    '3 - Widows System Directory (GetSystemDirectory API)
    '4 - Windows Directory (GetWindowsDirectory API)
    '5 - Directories in the PATH environment variable.
    'We don't check the System directory.
    'I havn't tested PATH. There shouldn't be one in Windows95.
    Dim NamePart As String
    Dim ReadOnly As String

    If IniFileNameDefault > "" Then Exit Sub

    NamePart = App.EXEName & ".INI"

    'First, try the directory the executible is in
    If zIsIniReadWrite(Section, ReadOnly, App.Path & "\" & NamePart) Then Exit Sub
    'Current directory
    If zIsIniReadWrite(Section, ReadOnly, CurDir & "\" & NamePart) Then Exit Sub
    'Try the windows directory
    If zIsIniReadWrite(Section, ReadOnly, zWinDir() & "\" & NamePart) Then Exit Sub
    'Anywhere in the path? Last chance. This isn't good.
    If zIsIniReadWrite(Section, ReadOnly, NamePart) Then Exit Sub
    
    'I prefer a read only ini file to creating one.
    If ReadOnly > "" Then
        IniFileNameDefault = ReadOnly
        Exit Sub
    End If

    'We'll have to find a dir with write access.

    'First, try the directory the executible is in
    If zFindDirIsReadWrite(App.Path & "\" & NamePart) Then Exit Sub
    'Current directory
    If zFindDirIsReadWrite(CurDir & "\" & NamePart) Then Exit Sub
    'Try the windows directory
    If zFindDirIsReadWrite(zWinDir() & "\" & NamePart) Then Exit Sub
    
    'We are realy screwed. Now what? Let's just fall through.
End Sub

Private Function zIsIniReadWrite(ByVal Section As String, ByRef ReadOnly As String, ByVal TryFileName As String) As Boolean
                                        'HAY, Look at this^, by reference!
    'Called by zFindIniFileName.
    Dim Value As String
    Dim hFile As Long
    Dim colLabels As Collection

    On Error GoTo Trap
    If zFileExists(TryFileName) Then
        'At least we have read access.
        If ReadOnly = "" Then ReadOnly = TryFileName
        'Do we have write access to this file?
        'Use IniWrite to find out.
        Set colLabels = IniLabels(Section, TryFileName)
        If colLabels.Count > 0 Then
            Value = IniFile(Section, colLabels(1), TryFileName)
            IniFile(Section, colLabels(1), TryFileName) = Value
        Else
            'Let's just try opening it.
            hFile = FreeFile
            Open IniFileNameDefault For Append As hFile
            Close hFile
        End If
        'If we get this far without an error then we got what we want.
        'Otherwise, we should keep looking.
        IniFileNameDefault = TryFileName
        zIsIniReadWrite = True
    End If
Trap:
    Exit Function
End Function

Private Function zFileExists(ByVal FileName As String) As Boolean
    'You might find this same function coded in other modules.
    'It is coded separatelly here to make this module more reusable.
    'Called privatelly by zIsIniReadWrite.
    
    'This function returns True if the named file exists.
    'This version of FileExists is better than the one that uses Dir
    'because it won't screw up other code that uses Dir.
    Dim hFile As Long
    
    hFile = FreeFile
    'If the file doesn't exist, "For Input"
    'makes an error occur and won't make an empty file.
    On Error GoTo Trap
    Open FileName For Input As hFile
    On Error GoTo 0
    Close hFile
    zFileExists = True
    Exit Function
    
Trap:
    If Err.Number <> 53 Then 'File not found.
        Err.Raise Err.Number, , Err.Description
    End If
    Exit Function
End Function


Public Property Get IniFile(ByVal Section As String, _
    ByVal Label As String, ByVal FileName As String) As String
    
    'See General Declarations for documentation.
    
    Dim StrLen As Long
    Dim Buffer As String * FIX_LENGTH
    Dim Msg As String

    StrLen = IniGetApi(Section, Label, "", Buffer, FIX_LENGTH, FileName)
    If IniOnBlankRaiseError And StrLen = 0 Then
        Msg = "The value of " & Label & " in section " & Section
        Msg = Msg & " of " & FileName & " is blank."
        Err.Raise 9996, , Msg
    End If
    
    IniFile = Left$(Buffer, StrLen)
End Property

Public Property Get Ini(ByVal Section As String, _
    ByVal Label As String) As String
    
    'See General Declarations for documentation.
    If IniFileNameDefault = "" Then Call zFindIniFileName(Section)
    Ini = IniFile(Section, Label, IniFileNameDefault)
End Property

Public Property Let IniFile(ByVal Section As String, _
    ByVal Label As String, _
    ByVal FileName As String, Value As String)
    
    'See General Declarations for documentation.
    
    If IniWriteApi(Section, Label, Value, FileName) = 0 Then
        Err.Raise 9999, , "Unsuccessful writing to INI file"
    End If
End Property

Public Property Let Ini(ByVal Section As String, _
    ByVal Label As String, ByVal Value As String)
    
    'See General Declarations for documentation.
    If IniFileNameDefault = "" Then Call zFindIniFileName(Section)
    IniFile(Section, Label, IniFileNameDefault) = Value
End Property