[RESOLVED] Loading a IniFile into a Dictionary

[HKcom]

Hi guys
Would you please help me with a class that load an iniFile into a Dictionary of course in VB6

[Arnoutdv]

What kind of structure is your INI file and how do you want it to be represented in a Dictionary?

This is what a typical INI file looks like

[mainitems]
item1=Whatever
item2=Something else

[otheritems]
item1=Who knows
item2=What?

[HKcom]

What kind of structure is your INI file and how do you want it to be represented in a Dictionary?

This is what a typical INI file looks like

[mainitems]
item1=Whatever
item2=Something else

[otheritems]
item1=Who knows
item2=What?

yes this is it
and when you Debug.Print the same structure shows up

[HKcom]

my first solution
the problem is that I want to allow duplicate keys and headers

Option Explicit

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 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 WritePrivateProfileSection Lib "kernel32" Alias _
                        "WritePrivateProfileSectionA" ( _
                        ByVal lpAppName 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


Dim mFileName As String
Dim keyValues As New Dictionary
Dim Main As New Dictionary

Private Sub Command1_Click()
 Dim i As Integer, j As Integer



Dim x As String
Dim Key As Variant
Dim tem As Variant


Dim Sections() As String
Sections = GetList(vbNullString)



Dim mkey As String
Dim mValue As String



For i = 0 To UBound(Sections)
  Set keyValues = GetIniValues(Sections(i), mFileName)
  Main.Add "[" & Sections(i) & "]", ""
  For j = 0 To keyValues.Count - 1
  mkey = keyValues.Keys(j)
  mValue = keyValues.Items(j)
  If Main.Exists(mkey) Then mkey = mkey & j
  Main.Add mkey, mValue
  Next
Next


For Each Key In Main.Keys
x = Key & "=" & Main(Key)

If (InStr(Key, "[") <> 0 And InStr(Key, "]") <> 0) Then x = Replace(x, "=", "")
Debug.Print x
Next

End Sub

Private Function GetIniValues(ByRef Section As String, sFilePath As String) As Dictionary

    '    If Len(Section) = 0 Then Exit Function
    
    Dim Buf As String
    Dim Size    As Long
    '    Dim Dict  As New Dictionary
    Dim dict  As New Dictionary
    Size = 16384
    
    Do
        Size = Size * 2
        Buf = String$(Size, vbNullChar)
        Size = GetPrivateProfileSection(Section, Buf, Size, sFilePath)
    Loop While Size = Len(Buf) - 2
    
        
    If Size > 0 Then
        Dim Entries() As String
        Entries = Split(Left$(Buf, Size - 1), vbNullChar)
    
        Dim KeyValue() As String
        Dim i           As Long
        For i = 0 To UBound(Entries)
            KeyValue = Split(Entries(i), "=")

            If UBound(KeyValue) = 1 Then
'                If (KeyValue(1) = "0000" Or KeyValue(1) = "00000") Then KeyValue(1) = vbNullString
                dict.Add KeyValue(0), KeyValue(1)
            Else
                dict.Add KeyValue(0), vbNullString
            End If
        Next i
    End If
    
    '    qSort Dict, False
    Set GetIniValues = dict
    
End Function

Private Function GetList(ByRef Section As String) As String()
    Dim Size    As Long
    Dim Buf     As String
    Dim List()  As String
    
    Size = 512
    
    Do
        Size = Size * 2
        Buf = String$(Size, vbNullChar)
        Size = GetPrivateProfileString(Section, vbNullString, "", Buf, Size, mFileName)
    Loop While Size = Len(Buf) - 1
    
    If Size > 0 Then
        List = Split(Left$(Buf, Size - 1), vbNullChar)
    End If
    
    GetList = List
End Function

Private Sub Form_Load()
mFileName = App.Path & "\Test.ini"
End Sub

[Zvoni]

Duplicate Keys where? Within a Section?
That doesn't make sense.

OTOH, a key can be repeated in a different section.

Sections in an INI-File: Must be unique
Keys within a Section: Must be unique.

[HKcom]

Duplicate Keys where? Within a Section?
That doesn't make sense.

OTOH, a key can be repeated in a different section.

Sections in an INI-File: Must be unique
Keys within a Section: Must be unique.

yes I know
sometimes I'am dealing with some inifiles that have duplicate keys or duplicate headers.."work files" it doesn't matter..

[wqweto]

Check this out

Option Explicit

Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, ByVal nSize As Long, 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 Sub Form_Load()
    Dim oIniFile        As Object
    
    Set oIniFile = ReadIniFile("test.ini")
    Debug.Print oIniFile("Profiles")("ProfilesCount")
End Sub

Private Function ReadIniFile(sFile As String) As Object
    Const BUFFER_SIZE   As Long = &H10000
    Dim oRetVal         As Object
    Dim sBuffer         As String
    Dim lSize           As Long
    Dim vSection        As Variant
    Dim oSection        As Object
    Dim vElem           As Variant
    
    Set oRetVal = CreateObject("Scripting.Dictionary")
    oRetVal.CompareMode = vbTextCompare
    sBuffer = String(BUFFER_SIZE, 0)
    lSize = GetPrivateProfileSectionNames(sBuffer, Len(sBuffer), sFile)
    If lSize > 0 Then
    For Each vSection In Split(Left$(sBuffer, lSize - 1), vbNullChar)
        Set oSection = CreateObject("Scripting.Dictionary")
        oSection.CompareMode = vbTextCompare
        Set oRetVal.Item(vSection) = oSection
        lSize = GetPrivateProfileSection(vSection, sBuffer, Len(sBuffer), sFile)
        If lSize > 0 Then
            For Each vElem In Split(Left$(sBuffer, lSize - 1), vbNullChar)
                vElem = Split(vElem, "=", Limit:=2)
                If Left$(vElem(1), 1) = """" And Len(vElem(1)) >= 2 Then
                    oSection.Item(vElem(0)) = Mid$(vElem(1), 2, Len(vElem(1)) - 2)
                Else
                    oSection.Item(vElem(0)) = vElem(1)
                End If
            Next
        End If
    Next
    End If
    Set ReadIniFile = oRetVal
End Function

cheers,
</wqw>

[HKcom]

Check this out

Option Explicit

Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, ByVal nSize As Long, 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 Sub Form_Load()
    Dim oIniFile        As Object
    
    Set oIniFile = ReadIniFile("test.ini")
    Debug.Print oIniFile("Profiles")("ProfilesCount")
End Sub

Private Function ReadIniFile(sFile As String) As Object
    Const BUFFER_SIZE   As Long = &H10000
    Dim oRetVal         As Object
    Dim sBuffer         As String
    Dim lSize           As Long
    Dim vSection        As Variant
    Dim oSection        As Object
    Dim vElem           As Variant
    
    Set oRetVal = CreateObject("Scripting.Dictionary")
    oRetVal.CompareMode = vbTextCompare
    sBuffer = String(BUFFER_SIZE, 0)
    lSize = GetPrivateProfileSectionNames(sBuffer, Len(sBuffer), sFile)
    If lSize > 0 Then
    For Each vSection In Split(Left$(sBuffer, lSize - 1), vbNullChar)
        Set oSection = CreateObject("Scripting.Dictionary")
        oSection.CompareMode = vbTextCompare
        Set oRetVal.Item(vSection) = oSection
        lSize = GetPrivateProfileSection(vSection, sBuffer, Len(sBuffer), sFile)
        If lSize > 0 Then
            For Each vElem In Split(Left$(sBuffer, lSize - 1), vbNullChar)
                vElem = Split(vElem, "=", Limit:=2)
                If Left$(vElem(1), 1) = """" And Len(vElem(1)) >= 2 Then
                    oSection.Item(vElem(0)) = Mid$(vElem(1), 2, Len(vElem(1)) - 2)
                Else
                    oSection.Item(vElem(0)) = vElem(1)
                End If
            Next
        End If
    Next
    End If
    Set ReadIniFile = oRetVal
End Function

cheers,
</wqw>

thank you wqweto
your solution is so far better than mine
but I got an error 13 "Type mismatch" in this line Debug.Print oIniFile("Profiles")("ProfilesCount")

Profiles??? ProfilesCount???

thank you

[Schmidt]

And a short version without any APIs:
(using the following content in "c:\temp\test.ini"):

[mainitems]
item1= 123
item2= Something else

[otheritems]
item1 =Who knows
item2 = "What the...?"

Option Explicit
 
Private Sub Form_Load()
    Dim oIni As Object
    Set oIni = ReadIniToDict("c:\temp\test.ini")
    
    Debug.Print "Found "; oIni.Count & " Sections: (" & Join(oIni.keys, ", ") & ")"
    Debug.Print "MainItems>Item1:", oIni("MainItems")("Item1")
    Debug.Print "OtherItems>Item2:", oIni("OtherItems")("Item2")
End Sub

Private Function ReadIniToDict(FileName As String) As Object
  Set ReadIniToDict = CreateObject("Scripting.Dictionary")
      ReadIniToDict.CompareMode = vbTextCompare
  Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
  Dim Line, Section As Object, ItemArr() As String, V As String
  
  For Each Line In Split(FSO.OpenTextFile(FileName).ReadAll, vbCrLf)
     Line = Trim(Line)
     If Left(Line, 1) = "[" And Len(Line) > 1 Then
        Set Section = CreateObject("Scripting.Dictionary")
            Section.CompareMode = vbTextCompare
        ReadIniToDict.Add Mid(Line, 2, Len(Line) - 2), Section
     ElseIf InStr(Line, "=") Then
        ItemArr = Split(Line, "=", 2): V = Trim$(ItemArr(1))
        If Left$(V, 1) = """" And Len(V) > 1 Then V = Mid$(V, 2, Len(V) - 2)
        Section(Trim$(ItemArr(0))) = V
     End If
  Next
End Function

HTH

Olaf

[wqweto]

thank you wqweto
your solution is so far better than mine
but I got an error 13 "Type mismatch" in this line Debug.Print oIniFile("Profiles")("ProfilesCount")

Profiles??? ProfilesCount???

Well, this is just an example how to access section Profiles and then element ProfilesCount within it.

Check out Olaf's sample -- it's the same "model" he loads the .ini file to.

cheers,
</wqw>

[HKcom]

You Guys are Very AWESOME ...

Now I got the big picture..

thank you Very much.

[dilettante]

Keep in mind that true INI files are not meant to be single-user. Multiple processes are allowed read and write them simultaneously. That means loading one up into a DOM and holding it there is fraught with peril. Lost or corrupted data, crashes, all sorts of woes await you.

You can do this, but it is all on you to control access through locking if necessary. The only locking readily available to you is whole file locking due to the general nature of stream files.