Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How To Read/Write to Ini files using ...PrivateProfile... API commands

Windows API

How To Read/Write to Ini files using ...PrivateProfile... API commands

by  Karl Blessing  Posted    (Edited  )
This is what I have so far as reading goes, this example loads all the Sections into a Collection, then all the Something=Something into Items under that

IniAPI.bas (module)
[tt]
Option Explicit

Public Ini As New IniFile

Private Declare Function GetPrivateProfileSectionNames _
Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" _
(ByVal lpReturnBuffer As String, ByVal nSize As Long, _
ByVal lpName 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 lpName As String) As Long

Private Declare Function WritePrivateProfileSection _
Lib "kernel32" Alias "WritePrivateProfileSectionA" _
(ByVal lpAppName As String, ByVal lpString As String, _
ByVal lpName 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 lpName As String) As Long


Public Sub ReadData()
Dim strSections As String, lngSize As Long, astrSections As Variant, astrItems As Variant, i As Integer, Items As Variant
Dim ptrSec As New Section
Dim ptrItm As New Items

On Error GoTo HandleErrors
Form1.Label1.Caption = ""
lngSize = 1024
Do
strSections = Space$(lngSize)
lngSize = GetPrivateProfileSectionNames(strSections, lngSize, "C:\kbstuff\inistuff\Test.ini")
If lngSize = 0 Then
GoTo ExitHere
ElseIf lngSize = Len(strSections) - 2 Then
lngSize = lngSize * 2
Else
strSections = Left$(strSections, lngSize - 1)
Exit Do
End If
Loop
astrSections = Split(strSections, vbNullChar)
For i = LBound(astrSections) To UBound(astrSections) - 1
ptrSec.Name = astrSections(i)

astrItems = GetValues(astrSections(i))
For Each Items In astrItems
ptrItm.Name = Items
ptrSec.Items.Add ptrItm, ptrSec.Name & ptrItm.Name
Set ptrItm = New Items
Next
Ini.Section.Add ptrSec, ptrSec.Name
Set ptrSec = New Section
Next i
ExitHere:
Exit Sub

HandleErrors:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub


Public Function GetValues(Section As Variant) As Variant
Dim strSections As String
Dim lngSize As Long
Dim astrSections As Variant
Dim i As Integer
On Error GoTo HandleErrors
lngSize = 1024
Do
strSections = Space$(lngSize)
lngSize = GetPrivateProfileSection(Section, strSections, lngSize, "C:\kbstuff\inistuff\Test.ini")
If lngSize = 0 Then
GoTo ExitHere
ElseIf lngSize = Len(strSections) - 2 Then
lngSize = lngSize * 2
Else
strSections = Left$(strSections, lngSize - 1)
Exit Do
End If
Loop
astrSections = Split(strSections, vbNullChar)
GetValues = astrSections
ExitHere:
Exit Function
HandleErrors:
Err.Raise Err.Number, Err.Source, Err.Description
End Function

Public Sub CleanUpIni()

Dim Num As Integer
Dim TmpSec As Section, TmpItm As Items

For Each TmpSec In Ini.Section
For Each TmpItm In TmpSec.Items
TmpSec.Items.Remove TmpSec.Name & TmpItm.Name
Next
Ini.Section.Remove TmpSec.Name
Next

End Sub
[/tt]

IniFile.cls (class module)
[tt]
Option Explicit
Public Section As New Collection
[/tt]

Section.cls (class module)
[tt]
Option Explicit
Public Items As New Collection
Public Name As String
[/tt]

Items.cls (class module)
[tt]
Option Explicit
Public Name As String
[/tt]

form1.frm
(form that contains a label1 and a commandbutton
just to help you know how to flip through the collection)

[tt]
Option Explicit

Private Sub Command1_Click()
ReadData
Label1.Caption = ""
Dim itm As Items
Dim sec As Section
For Each sec In Ini.Section
Label1.Caption = Label1.Caption & sec.Name & vbCrLf
For Each itm In sec.Items
Label1.Caption = Label1.Caption & " -" & itm.Name & vbCrLf
Next
Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
CleanUpIni
End Sub
[/tt]
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top