VBA verwijzingen

INI

Een INI-bestand is een tekstbestand. Met behulp van de klassenmodule clsTekstINI kunnen de waarden uit dit tekstbestand worden geladen, gewijzigd en verwijderd.

Voor deze bron hoeft geen verwijzing gemaakt te worden, echter is het wel noodzakelijk om de module modTekstINI ook op te nemen in de toepassing.

In de plaats van een verwijzing naar een ingebouwde bibliotheek wordt er nu gebruik gemaakt van een externe bibliotheek in de vorm van een module.

De hiërarchie van zo’n tekstbestand bestaat uit secties, sleutels en waarden. Een voorbeeld van een sectie is [1], een voorbeeld van een sleutel is VOORNAAM en een voorbeeld van een waarde is Kaylie.

Het gebruik van zo’n INI-bestand is ideaal voor het opslaan en opvragen van gebruikers- en/of systeemgebonden instellingen. Het werkt snel en is makkelijk te beheren.

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 28-3-2017
' Object        : clsTekstINI
' Doel          : waarden laden, wijzigen en verwijderen uit TekstBestandINI m.b.v. modTekstINI
' Objecten      : 1. Sectie
'                 2. Sleutel
'                 3. Waarde
'-----------------------------------------------------------------------------------------------------------------------

Option Explicit

Public Sub Laden(lsb As ListBox)

'   Waarden uitlezen op sectieniveau (=nummer)

    Dim strSecties() As String
    Dim strSectie As Variant
    Dim i As Integer
    
    strSecties = SectiesINI(TekstBestandINI)
    
    For Each strSectie In strSecties
        With lsb
            .AddItem
            .List(i, 0) = strSectie
            .List(i, 1) = LeesINI(CStr(strSectie), "Voornaam", TekstBestandINI)
            .List(i, 2) = LeesINI(CStr(strSectie), "Achternaam", TekstBestandINI)
        End With
        i = i + 1
    Next

End Sub

Public Sub Toevoegen(strNummer As String, strVoornaam As String, strAchternaam As String)

'   Toevoegen aan INI-bestand

    SchrijfINI strNummer, "Voornaam", strVoornaam, TekstBestandINI
    SchrijfINI strNummer, "Achternaam", strAchternaam, TekstBestandINI

End Sub

Public Sub Wijzig(strNummer As String, strVoornaam As String, strAchternaam As String)

'   Wijzigen is gelijk aan toevoegen

    Toevoegen strNummer, strVoornaam, strAchternaam

End Sub

Public Sub Verwijder(strNummer As String, blnAlles As Boolean)

'   Heel bestand verwijderen of aan de hand van nummer hele sectie verwijderen
    
    If blnAlles = True Then
        Kill TekstBestandINI
    Else
        SchrijfINI strNummer, "", "", TekstBestandINI
    End If
    
End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 28-3-2017
' Object        : modTekstINI
' Doel          : ondersteuning voor klasse clsTekstINI
' Opmerking     : ingebouwde functies
'-----------------------------------------------------------------------------------------------------------------------

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpBestand As String) As Long
    Public Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpBestand As String) As Long
    Private Declare PtrSafe Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, ByVal nSize As Long, ByVal lpBestand As String) As Long
#Else
    Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpBestand As String) As Long
    Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpBestand As String) As Long
    Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, ByVal nSize As Long, ByVal lpBestand As String) As Long
#End If

Public Function LeesINI(strSectie As String, strSleutel As String, strBestand As String) As String

'   Waarde lezen

    Dim strBuffer As String
    strBuffer$ = String$(750, Chr$(0&))
    LeesINI$ = Left$(strBuffer$, GetPrivateProfileString(strSectie$, ByVal UCase$(strSleutel$), "", strBuffer, Len(strBuffer), strBestand$))

End Function

Public Sub SchrijfINI(strSectie As String, strSleutel As String, strWaarde As String, strBestand As String)

'   Waarde wegschrijven; zijn sleutel en waarde leeg dan gehele sectie verwijderen

    If strSleutel = "" And strWaarde = "" Then
        WritePrivateProfileString strSectie$, vbNullString, vbNullString, strBestand$
    Else
        WritePrivateProfileString strSectie$, UCase$(strSleutel$), strWaarde$, strBestand$
    End If

End Sub

Public Function SectiesINI(strBestand As String) As String()
    
'   Array voor secties
    
    If Dir(strBestand) = "" Then Exit Function
    
    Dim strBuffer As String, intLengte As Integer
    
    Do While (intLengte = Len(strBuffer) - 2) Or (intLengte = 0)
    
        If strBuffer = vbNullString Then
            strBuffer = Space(256)
        Else
            strBuffer = String(Len(strBuffer) * 2, 0)
        End If
    
        intLengte = GetPrivateProfileSectionNames(strBuffer, Len(strBuffer), strBestand)
    
    Loop
    
    strBuffer = Left$(strBuffer, intLengte)
    
    SectiesINI = Split(strBuffer, vbNullChar)
    
    ReDim Preserve SectiesINI(UBound(SectiesINI) - 1) As String

End Function