VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "INIControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Declare Function GetPrivateProfileInt Lib "kernel32" _
 Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
 ByVal lpKeyName As String, ByVal nDefault As Long, _
 ByVal lpFileName As String) As Long
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
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
Private Declare Function WritePrivateProfileSection Lib "kernel32" _
 Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, _
 ByVal lpString As String, ByVal lpFileName As String) As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" _
  Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
  ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
  "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize _
  As Long) As Long
  
Private strWinDir As String, strSysDir As String, strINI As String
Private strThisModule As String
Private bFileExists As Boolean, bOK2Overwrite As Boolean, bOK2Create As Boolean

Private Sub Class_Initialize()
    strThisModule = VBE.ActiveVBProject.Name & ".INIControl"
    strWinDir = String$(255, 0)
    GetWindowsDirectory strWinDir, 255&
    strWinDir = Left$(strWinDir, InStr(strWinDir, Chr$(0)) - 1)
    strSysDir = String$(255, 0)
    GetSystemDirectory strSysDir, 255&
    strSysDir = Left$(strSysDir, InStr(strSysDir, Chr$(0)) - 1)
    strINI = strWinDir & "\win.ini"
    bFileExists = True
    vDefault = Null
    bOK2Overwrite = True
End Sub

Public Property Get FileExists() As Boolean
    If FileSystem.Dir(strWinDir & "\" & strINI) <> "" Then
        bFileExists = True
    Else
        bFileExists = False
    End If
    FileExists = bFileExists
End Property

Public Property Get FileName() As String
    FileName = strINI
End Property

Public Property Let FileName(strSetting As String)
    If UCase(Right$(strSetting, 4)) <> ".INI" Then
        strSetting = strSetting & ".INI"
    End If
    If FileSystem.Dir(strWinDir & "\" & strSetting) <> "" Then
        strINI = strSetting
        bFileExists = True
    Else
        bFileExists = False
    End If
End Property

Public Property Get WindowsDirectory() As String
    WindowsDirectory = strWinDir
End Property

Public Property Get SystemDirectory() As String
    SystemDirectory = strSysDir
End Property

Public Property Get ProfileEntryString(strCategory As String, strItem As String, Optional vDefault As Variant) As String
    Dim strReturn As String, strDefault As String
    
    If IsMissing(vDefault) Then
        If Me.ParameterExists(strCategory, strItem) = False Then
            Exit Property
        Else
            strDefault = ""
        End If
    Else
        strDefault = CStr(vDefault)
    End If
    strReturn = String$(128, 0)
    If GetPrivateProfileString(strCategory, strItem, strDefault, strReturn, CInt(Len(strReturn)), strINI) Then
        ProfileEntryString = Left$(strReturn, InStr(strReturn, Chr$(0)) - 1)
    Else
        ProfileEntryString = strDefault
    End If
End Property

Public Property Let ProfileEntryString(strCategory As String, strItem As String, Optional vDefault As Variant, strSetting As String)
    If strItem <> "" And strCategory <> "" Then
        If Me.ParameterExists(strCategory, strItem) Then
            If bOK2Overwrite = False Then
                Exit Property
            End If
        Else
            If bOK2Create = False Then
                Exit Property
            End If
        End If
        
        If WritePrivateProfileString(strCategory, strItem, strSetting, strINI) Then
            bFileExists = True
        Else
            Err.Raise vbObjectError + 513, strThisModule, "Cannot write to " & strFilename & "."
        End If
    End If
    bOK2Create = False
    bOK2Overwrite = True
End Property

Public Property Get ProfileEntryInt(strCategory As String, strItem As String, Optional vDefault As Variant) As Long
    Dim lDefault As Long
    
    If IsMissing(vDefault) Then
        If Me.ParameterExists(strCategory, strItem) = False Then
            Exit Property
        Else
            lDefault = 0&
        End If
    Else
        lDefault = CLng(vDefault)
    End If
    ProfileEntryInt = GetPrivateProfileInt(strCategory, strItem, lDefault, strINI)
End Property

Public Property Let ProfileEntryInt(strCategory As String, strItem As String, Optional vDefault As Variant, lSetting As Long)
    If strCategory <> "" And strItem <> "" Then
        If Me.ParameterExists(strCategory, strItem) Then
            If bOK2Overwrite = False Then
                Exit Property
            End If
        Else
            If bOK2Create = False Then
                Exit Property
            End If
        End If
        
        If WritePrivateProfileString(strCategory, strItem, Trim$(CStr(lSetting)), strINI) Then
            bFileExists = True
        Else
            Err.Raise vbObjectError + 513, strThisModule, "Cannot write to " & strFilename & "."
        End If
    End If
    bOK2Create = False
    bOK2Overwrite = True
End Property

Public Property Get OK2Overwrite() As Boolean
    OK2Overwrite = bOK2Overwrite
End Property

Public Property Let OK2Overwrite(bSetting As Boolean)
    bOK2Overwrite = bSetting
End Property

Public Property Get OK2Create() As Boolean
    OK2Create = bOK2Create
End Property

Public Property Let OK2Create(bSetting As Boolean)
    bOK2Create = bSetting
End Property

Public Function CategoryExists(strCategory As String) As Boolean
    Dim strBuffer As String
    If strCategory <> "" Then
        strBuffer = String$(8192, 0)
        If GetPrivateProfileSection(strCategory, strBuffer, Len(strBuffer), strINI) Then
            If InStr(strBuffer, strCategory) > 0 Then
                CategoryExists = True
            End If
        End If
    End If
End Function

Public Function ParameterExists(strCategory As String, strKey As String) As Boolean
    Dim strBuffer As String, iPosition As Integer

    If strCategory <> "" And strKey <> "" Then
        strBuffer = String$(8192, 0)
        If GetPrivateProfileSection(strCategory, strBuffer, Len(strBuffer), strINI) Then
            iPosition = InStr(strBuffer, strKey)
            If iPosition > 0 Then
                If Mid$(strBuffer, iPosition + Len(strKey), 1) = "=" Then
                    ParameterExists = True
                End If
            End If
        End If
    End If
End Function

Public Function RemoveParameter(strCategory As String, strKey As String)
    Dim strBuffer As String
    Dim iSnipLeft As Integer, iSnipRight As Integer
    
    If strCategory <> "" And strKey <> "" Then
        If Me.ParameterExists(strCategory, strKey) Then
            strBuffer = String$(8192, 0)
            If GetPrivateProfileSection(strCategory, strBuffer, Len(strBuffer), strINI) Then
                iSnipLeft = InStr(strBuffer, strKey)
                iSnipRight = InStr(iSnipLeft, strBuffer, Chr$(0))
                strBuffer = Left$(strBuffer, iSnipLeft - 1) & Right$(strBuffer, Len(strBuffer) - iSnipRight)
                WritePrivateProfileSection strCategory, strBuffer, strINI
            End If
        End If
    End If
End Function