Atelier : Fichiers de configuration Correction complète.

La correction présentée ici se présente comme un module autonome, pour être intégré dans n'importe quel projet. Vous remarquez :

• La ditinction entre les variables privés (utilisées uniquement par le module et inutiles pour le programme appelant, par exemple Configuration) et les variables publiques (qui renvoient des informations pertinentes au programme appelant, par exemple les codes d'erreur) ;
• Une gestion d'erreur, qui permet de signaler au programme appelant les erreurs précises qui peuvent survenir ;
• Les fonctions et variables publiques sont préfixées par Config_ pour bien reconnaître, dans le programme appelant, qu'elles proviennent de ce module. Par exemple : Config_ErreurCode, Config_ChargeConfig, Config_GetValeur, etc.
• Config_ChargeConfig reçoit en paramètre le nom du fichier de configuration à utiliser. Ainsi, ce module peut servir pour n'importe quel programme.

Option Explicit

Public Config_ErreurCode As Integer
Public Config_ErreurIntitulé As String

Private Configuration As String ' La variable principale dans laquelle tout s'effectue
Private GlobalChemin As String ' pour se souvenir du chemin entre ChargeConfig et SauveConfig

Public Sub Config_ChargeConfig(chemin As String)
    ' Transfère le contenu du fichier "Chemin"
    ' dans la variable de type string "Configuration"
    Configuration = ""
    If Dir(chemin) <> "" Then
        Dim f As Integer
        Dim ligne As String
        f = FreeFile
        Open chemin For Input As f
        Do Until EOF(f)
            Line Input #f, ligne
            Configuration = Configuration & ligne & vbCrLf
        Loop
        Close f
        Configuration = Left$(Configuration, Len(Configuration) - Len(vbCrLf))
    End If
    GlobalChemin = chemin
End Sub

Public Sub Config_SauveConfig()
    ' Sauvegarde la nouvelle configuration
    ' sur le fichier qui a été utilisé dans ChargeConfig
    Dim f As Integer
    f = FreeFile
    Open GlobalChemin For Output As f
    Print #f, Configuration
    Close f
End Sub

Public Function Config_GetValeur(Rubrique As String, MotClé As String) As String
    ' Renvoie la valeur correspondant à la rubrique et au mot-clé passés en paramètre
    Dim PosRubrique As Integer, PosMotClé As Integer
    Dim PosRubriqueSuivante As Integer, PosEgal As Integer, PosCrLf As Integer
    PosRubrique = InStr(1, Configuration, "[" & Rubrique & "]", vbTextCompare)
    If PosRubrique = 0 Then
        Config_ErreurCode = 1
        Config_ErreurIntitulé = "La rubrique " & Rubrique & " n'existe pas."
    Else
        PosMotClé = InStr(PosRubrique, Configuration, MotClé & "=", vbTextCompare)
        PosRubriqueSuivante = InStr(PosRubrique, Configuration, vbCrLf & "[")
        If (PosRubriqueSuivante > 0 And PosMotClé > PosRubriqueSuivante) Or PosMotClé = 0 Then
            Config_ErreurCode = 2
            Config_ErreurIntitulé = "La rubrique " & Rubrique & " ne contient pas le mot-clé " & MotClé & "."
        Else
            PosEgal = InStr(PosMotClé, Configuration, "=")
            PosCrLf = InStr(PosMotClé, Configuration, vbCrLf)
            Config_ErreurCode = 0
            Config_ErreurIntitulé = ""
            Config_GetValeur = Mid$(Configuration, PosEgal + 1, PosCrLf - PosEgal - 1)
        End If
    End If
End Function

Public Sub Config_SetValeur(Rubrique As String, MotClé As String, Valeur As String)
    ' Renvoie la valeur correspondant à la rubrique et au mot-clé passés en paramètre
    Dim PosRubrique As Integer, PosMotClé As Integer
    Dim PosRubriqueSuivante As Integer, PosEgal As Integer, PosCrLf As Integer
    PosRubrique = InStr(1, Configuration, "[" & Rubrique & "]", vbTextCompare)
    If PosRubrique = 0 Then
        ' La rubrique n'existe pas : on l'ajoute à la fin
        Configuration = Configuration & vbCrLf & "[" & Rubrique & "]" & vbCrLf
        Configuration = Configuration & MotClé & "=" & Valeur & vbCrLf
    Else
        PosMotClé = InStr(PosRubrique, Configuration, MotClé & "=", vbTextCompare)
        PosRubriqueSuivante = InStr(PosRubrique, Configuration, vbCrLf & "[")
        If (PosRubriqueSuivante > 0 And PosMotClé > PosRubriqueSuivante) Or PosMotClé = 0 Then
            ' Le mot-clé n'existe pas dans cette rubrique : on l'ajoute au début de cette rubrique
            Configuration = Left(Configuration, PosRubrique + Len(Rubrique) + 2) & vbCrLf & MotClé & "=" & Valeur & Right(Configuration, Len(Configuration) - PosRubrique - Len(Rubrique) - 1)
        Else
            PosEgal = InStr(PosMotClé, Configuration, "=")
            PosCrLf = InStr(PosMotClé, Configuration, vbCrLf)
            Configuration = Left(Configuration, PosEgal) & Valeur & Right(Configuration, Len(Configuration) - PosCrLf + 1)
        End If
    End If
End Sub

Public Function Config_NoError() As Boolean
    Config_NoError = (Config_ErreurCode = 0)
End Function

Remarquez la gestion des erreurs faite ici, qui respecte la règle générale : les modules n'affichent pas de messages d'erreur. Ils se contentent de signaler les erreurs au programme appelant, celui-ci décide s'il doit l'afficher ou la traiter autrement.

Option Explicit
Sub main()
      ' Chargement de la configuration
      Config_ChargeConfig "c:\cdex.ini"
      ' Test de lecture d'une valeur
      Dim Valeur As String
      Valeur = Config_GetValeur("MainFrmBarSettings-Summary", "ScreenCX")
      If Config_NoError Then
          MsgBox "La valeur est : " & Valeur
      Else
          MsgBox "Erreur " & Config_ErreurCode & " : " & Config_ErreurIntitulé
      End If
      ' Test d'écriture d'une valeur
      Config_SetValeur "Autre Rubrique", "ScreenCX", "2560"
      ' Puis réaffichage de cette valeur
      MsgBox Config_GetValeur("MainFrmBarSettings-Summary", "ScreenCX")
      ' Sauvegarde de la nouvelle configuration
      Config_SauveConfig
  End Sub

Cf. cours.