|
-
May 26th, 2000, 01:47 AM
#1
Thread Starter
Addicted Member
This is what I have written so far, it does get back all the sections, and their values below them, which I soon hope to put each section into a collection, then the items under them. But I was curious, is there a possible shorter method than the one I have going?
Option Explicit
' From the IniFile class.
Private Declare Function GetPrivateProfileSectionNames _
Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" _
(ByVal lpReturnBuffer As String, ByVal nSize As Long, _
ByVal lpName As String) As Long
' From the IniFile class.
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
' From the IniSection class.
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
Dim lngSize As Long
Dim astrSections As Variant
Dim astrItems As Variant
Dim i As Integer
Dim Items As Variant
On Error GoTo HandleErrors
Form1.Label1.Caption = ""
' In most cases, 1024 characters is enough, but if it's
' not, the code will double that and try again.
lngSize = 1024
Do
strSections = Space$(lngSize)
lngSize = GetPrivateProfileSectionNames(strSections, lngSize, "C:\kbstuff\inistuff\Test.ini")
If lngSize = 0 Then
' No sections, so get out of here!
GoTo ExitHere
ElseIf lngSize = Len(strSections) - 2 Then
' That's how the API indicates you didn't allow
' enough space, but returning the size you originally
' specified, less 2. In that case, just double the
' buffer, and try again.
lngSize = lngSize * 2
Else
' Trim the extra stuff. Use lngSize - 1 because
' there's an extra vbNullChar at the end of this
' string.
strSections = Left$(strSections, lngSize - 1)
Exit Do
End If
Loop
' Now strSections contains the section names, separated
' with vbNullChar.
astrSections = Split(strSections, vbNullChar)
For i = LBound(astrSections) To UBound(astrSections) - 1
' Add the section to the collection, indicating that
' it's not a NEW section. That is, it's not being added
' after the file was read. That way, the code there can
' know to not bother looking for items when being added
' by code later.
Form1.Label1.Caption = Form1.Label1.Caption & astrSections(i) & vbCrLf
astrItems = GetValues(astrSections(i))
For Each Items In astrItems
Form1.Label1.Caption = Form1.Label1.Caption & " " & Items & vbCrLf
Next
'Call AddSection(astrSections(i), False)
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
' In most cases, 1024 characters is enough, but if it's
' not, the code will double that and try again.
lngSize = 1024
Do
strSections = Space$(lngSize)
lngSize = GetPrivateProfileSection(section, strSections, lngSize, "C:\kbstuff\inistuff\Test.ini")
If lngSize = 0 Then
' No sections, so get out of here!
GoTo ExitHere
ElseIf lngSize = Len(strSections) - 2 Then
' That's how the API indicates you didn't allow
' enough space, but returning the size you originally
' specified, less 2. In that case, just double the
' buffer, and try again.
lngSize = lngSize * 2
Else
' Trim the extra stuff. Use lngSize - 1 because
' there's an extra vbNullChar at the end of this
' string.
strSections = Left$(strSections, lngSize - 1)
Exit Do
End If
Loop
' Now strSections contains the section names, separated
' with vbNullChar.
astrSections = Split(strSections, vbNullChar)
GetValues = astrSections
ExitHere:
Exit Function
HandleErrors:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
Any Help, command, critism, joke is appreaciated.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|