VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IniClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public IniCollection As Dictionary
Private CaseMode As Boolean
Public CurrentFileName As String
Public Function GetSection(ByVal Section As String) As Variant
GetSection = IniCollection(Section).Keys
End Function
Public Sub EmptySection(ByVal Section As String)
IniCollection(Section).RemoveAll
End Sub
Private Sub SetCompare()
If (CaseMode = False) Then IniCollection.CompareMode = TextCompare Else IniCollection.CompareMode = BinaryCompare
End Sub
Private Sub ProcessIni(ByVal Data As String, Optional ByVal CommentMode As Boolean = True, Optional ByVal Rebuild As Boolean = True)
On Error Resume Next
Dim i As Long, TempData1 As String, TempData2 As String, SplitData As Variant, LineData As String, CurSection As String, EqlPos As Long
If (Rebuild) Then Set IniCollection = New Dictionary
SetCompare
Data = Replace$(Data, vbCr, "")
Data = Replace$(Data, vbLf, vbCrLf)
SplitData = Split(Data, vbCrLf)
For i = LBound(SplitData) To UBound(SplitData)
LineData = SplitData(i)
If ((Left$(LineData, 1) = "#") And (CommentMode)) Then GoTo SkipLine
If (Len(LineData) = 0) Then GoTo SkipLine
If ((Left$(LineData, 1) = "[") And (Right$(LineData, 1) = "]")) Then
CurSection = Left$(LineData, Len(LineData) - 1)
CurSection = Right$(CurSection, Len(CurSection) - 1)
If Not (IniCollection.Exists(CurSection)) Then
IniCollection.Add CurSection, New Dictionary
End If
Else
EqlPos = InStr(1, LineData, "=")
If (EqlPos = 0) Then GoTo SkipLine
TempData1 = Left$(LineData, EqlPos - 1)
TempData2 = Right$(LineData, Len(LineData) - EqlPos)
If (IniCollection(CurSection).Exists(TempData1)) Then
IniCollection(CurSection).Remove TempData1
IniCollection(CurSection).Add TempData1, CStr(TempData2)
Else
IniCollection(CurSection).Add TempData1, CStr(TempData2)
End If
End If
SkipLine:
Next i
End Sub
Public Property Get CaseSensitive() As Boolean
CaseSensitive = CaseMode
End Property
Public Property Let CaseSensitive(ByVal NewMode As Boolean)
CaseMode = NewMode
End Property
Public Sub OpenINI(ByVal FileName As String, Optional ByVal CommentMode As Boolean = True)
On Error Resume Next
Dim FB As Integer, Data As String
FB = FreeFile
Open FileName For Binary As #FB
Data = Space$(LOF(FB))
Get #FB, 1, Data
Close #FB
ProcessIni Data, CommentMode
If (Err.Number <> 0) Then Err.Clear: Exit Sub
CurrentFileName = FileName
End Sub
Public Sub InputINI(ByVal Data As String, Optional ByVal CommentMode As Boolean = True)
On Error Resume Next
ProcessIni Data, CommentMode
Err.Clear
End Sub
Public Sub InsertData(ByVal Data As String, Optional ByVal CommentMode As Boolean = True)
On Error Resume Next
ProcessIni Data, CommentMode, False
Err.Clear
End Sub
Public Sub InsertINI(ByVal FileName As String, Optional ByVal CommentMode As Boolean = True)
On Error Resume Next
Dim FB As Integer, Data As String
FB = FreeFile
Open FileName For Binary As #FB
Data = Space$(LOF(FB))
Get #FB, 1, Data
Close #FB
ProcessIni Data, CommentMode, False
Err.Clear
End Sub
Public Sub NewINI()
Set IniCollection = New Dictionary
If (CaseMode) Then
IniCollection.CompareMode = BinaryCompare
Else
IniCollection.CompareMode = TextCompare
End If
End Sub
Public Function ReadKey(ByVal Section As String, ByVal KeyName As String) As String
ReadKey = IniCollection(Section)(KeyName)
End Function
Public Function ReadKeyEscaped(ByVal Section As String, ByVal KeyName As String) As String
ReadKeyEscaped = UnEscaped(ReadKey(Section, KeyName))
End Function
Public Sub WriteKey(ByVal Section As String, ByVal KeyName As String, ByVal Data As String)
If Not (IniCollection.Exists(Section)) Then
IniCollection.Add Section, New Dictionary
End If
If Not (IniCollection(Section).Exists(KeyName)) Then
IniCollection(Section).Add KeyName, CStr(Data)
Else
IniCollection(Section)(KeyName) = CStr(Data)
End If
End Sub
Public Sub SaveINI(ByVal FileName As String)
On Error Resume Next
Dim FB As Integer, Data As String
Data = OutputINI
If (Len(Dir(FileName)) > 0) Then Kill FileName
FB = FreeFile
Open FileName For Binary As #FB
Put #FB, 1, Data
Close #FB
End Sub
Public Function OutputINI() As String
On Error Resume Next
Dim i As Long, j As Long, NewData As String, k1 As Variant, k2 As Variant
k1 = IniCollection.Keys
For i = LBound(k1) To UBound(k1)
If (NewData <> "") Then NewData = NewData & vbCrLf
NewData = NewData & "[" & k1(i) & "]"
k2 = IniCollection(k1(i)).Keys
For j = LBound(k2) To UBound(k2)
NewData = NewData & vbCrLf
NewData = NewData & k2(i) & "=" & IniCollection(k1(i))(k2(i))
Next j
Next i
OutputINI = NewData
End Function
Public Property Get KeyExists(ByVal Section As String, ByVal KeyName As String) As Boolean
If Not (IniCollection.Exists(Section)) Then KeyExists = False: Exit Property
KeyExists = IniCollection(Section).Exists(KeyName)
End Property
Public Property Let KeyExists(ByVal Section As String, ByVal KeyName As String, ByVal NewExists As Boolean)
If (NewExists) Then
If Not (IniCollection.Exists(Section)) Then IniCollection.Add Section, NewDictionary
If Not (IniCollection(Section).Exists(KeyName)) Then IniCollection(Section).Add KeyName, ""
Else
If Not (IniCollection.Exists(Section)) Then Exit Property
If (IniCollection(Section).Exists(KeyName)) Then IniCollection(Section).Remove KeyName
End If
End Property
Public Property Get SectionExists(ByVal Section As String, ByVal KeyName As String) As Boolean
SectionExists = IniCollection.Exists(KeyName)
End Property
Public Property Let SectionExists(ByVal Section As String, ByVal KeyName As String, ByVal NewExists As Boolean)
If (NewExists) Then
If Not (IniCollection.Exists(Section)) Then IniCollection.Add Section, NewDictionary
Else
If (IniCollection.Exists(Section)) Then IniCollection.Remove Section
End If
End Property
Public Property Get KeyData(ByVal Section As String, ByVal KeyName As String) As String
KeyData = ReadKey(Section, KeyName)
End Property
Public Property Let KeyData(ByVal Section As String, ByVal KeyName As String, ByVal NewData As String)
WriteKey Section, KeyName, NewData
End Property
Public Property Get KeyDataEscaped(ByVal Section As String, ByVal KeyName As String) As String
KeyDataEscaped = ReadKeyEscaped(Section, KeyName)
End Property
Public Property Let KeyDataEscaped(ByVal Section As String, ByVal KeyName As String, ByVal NewData As String)
WriteKeyEscaped Section, KeyName, NewData
End Property
Public Sub RemoveKey(ByVal Section As String, ByVal KeyName As String)
IniCollection(Section).Remove KeyName
End Sub
Public Sub RemoveSection(ByVal Section As String)
IniCollection.Remove Section
End Sub
Public Sub WriteKeyEscaped(ByVal Section As String, ByVal KeyName As String, ByVal Data As String)
WriteKey Section, KeyName, Escaped(Data)
End Sub
Private Sub UserControl_Initialize()
Set IniCollection = New Dictionary
End Sub
Private Function Escaped(ByVal Data As String) As String
Dim NewData As String
NewData = Data
NewData = Replace$(NewData, "\", "\\")
NewData = Replace$(NewData, vbCr, "\r")
NewData = Replace$(NewData, vbLf, "\n")
NewData = Replace$(NewData, vbTab, "\t")
NewData = Replace$(NewData, """", "\""")
Escaped = NewData
End Function
Private Function UnEscaped(ByVal Data As String) As String
On Error Resume Next
Dim NewData As String, char As String, i As Long, BackSlash As Boolean
If (Len(Data) = 0) Then UnEscaped = Data: Exit Function
For i = 1 To Len(Data)
char = Mid$(Data, i, 1)
If (BackSlash = True) Then
Select Case char
Case "\"
NewData = NewData & "\"
Case "r"
NewData = NewData & vbCr
Case "n"
NewData = NewData & vbLf
Case "t"
NewData = NewData & vbTab
Case """"
NewData = NewData & """"
Case Else
If (IsNumeric(char)) Then
NewData = NewData & Chr(Mid$(Data, i, 3))
i = i + 2
Else
NewData = NewData & "\" & char
End If
End Select
BackSlash = False
GoTo EndOfI
Else
If (char = "\") Then BackSlash = True: GoTo EndOfI
NewData = NewData & char
End If
EndOfI:
Next i
UnEscaped = NewData
End Function
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
CaseMode = PropBag.ReadProperty("CaseSensitive", False)
End Sub

Private Sub UserControl_Resize()
UserControl.Width = 705
UserControl.Height = 735
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("CaseSensitive", CaseMode, False)
End Sub