Utilisation des propertybag: fichier de configuration

Commenter

Contenu du snippet

Quand on doit sauver les options de configuration, on a deux choix: soit dans une DB (si le prg en utilise une), soit dans un fichier INI (trop lisible dans certains cas). Ce que je vous proprose est l'utilisation de l'objet PropertyBag qui n'est autre que celui utilisé quand on sauve les propriété d'un contrôle (.OCX) pendant le design-time. Sauver le contenu ci-dessous dans un fichier nommé config.cls

Source / Exemple : 


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Config"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private colPName As Collection
Private colPValue As Collection

Private Sub Class_Initialize()
  Set colPName = New Collection
  Set colPValue = New Collection
End Sub

Private Sub Class_Terminate()
  Set colPName = Nothing
  Set colPValue = Nothing
End Sub

Public Property Get PropertyValue(ByVal PropertyName As String) As Variant
Dim I As Integer

  I = PropertyIndex(PropertyName)
  If I > 0 Then
    PropertyValue = colPValue(I)
  Else
    PropertyValue = Null
  End If
End Property

Public Property Let PropertyValue(ByVal PropertyName As String, ByVal NewValue As Variant)
Dim I As Integer

  I = PropertyIndex(PropertyName)
  If I > 0 Then
    If IsNull(NewValue) = True Then
      colPName.Remove I
      colPValue.Remove I
    Else
      colPName.Add LCase$(Trim$(PropertyName))
      colPValue.Add NewValue
    End If
  Else
    If IsNull(NewValue) = False Then
      colPName.Add LCase$(Trim$(PropertyName))
      colPValue.Add NewValue
    End If
  End If
End Property

Public Function SaveFile(ByVal FileName As String) As Boolean
Dim PB As PropertyBag
Dim I As Integer

  If Len(FileName) > 0 Then
    Set PB = New PropertyBag
    PB.WriteProperty "PropertyCount", colPName.Count
    For I = 1 To colPName.Count
      PB.WriteProperty "PropertyName" & I, colPName(I)
      PB.WriteProperty "PropertyValue" & I, colPValue(I)
    Next
    On Error Resume Next
    Kill FileName
    On Error GoTo 0
    Open FileName For Binary As #1
    Put #1, , PB.Contents
    Close #1
  End If
  SaveFile = True
End Function

Public Function LoadFile(ByVal FileName As String) As Boolean
Dim PB As PropertyBag
Dim I As Integer
'Dim NbDtl As Integer
Dim vPB As Variant
Dim bPB() As Byte
'Dim VD As CVerDetail
'Dim Pwd As String

  ClearCollection colPName
  ClearCollection colPValue

  If Len(FileName) > 0 Then
    On Error GoTo ErrorOpen
    Open FileName For Binary As #1
    Get #1, , vPB
    bPB = vPB
    Close #1
    Set PB = New PropertyBag
    PB.Contents = bPB
    
    For I = 1 To PB.ReadProperty("PropertyCount", 0)
      colPName.Add PB.ReadProperty("PropertyName" & I, "")
      colPValue.Add PB.ReadProperty("PropertyValue" & I, Null)
    Next
    LoadFile = True
  Else
    LoadFile = False
  End If
  Exit Function

ErrorOpen:
  Close 1
  LoadFile = False
  Exit Function
End Function

Private Function PropertyExists(ByVal PropertyName As String) As Boolean
  If PropertyIndex(PropertyName) > 0 Then PropertyExists = True
End Function

Private Function PropertyIndex(ByVal PropertyName As String) As Integer
Dim I As Integer

  PropertyName = LCase$(Trim$(PropertyName))
  For I = 1 To colPName.Count
    If colPName(I) = PropertyName Then PropertyIndex = I: Exit Function
  Next
End Function

Private Sub ClearCollection(ByRef Col As Collection)
  While Col.Count > 0
    Col.Remove 1
  Wend
End Sub

Conclusion :


Voici un exemple d'utilisation. Mettez-le dans un module et n'oubliez pas de changer, dans le propriétés du projet, que le démarrage est la sub Main.

>>>>>>>> Début de sub Main >>>>>>>>>>>>>>>>>
Sub Main()
Dim X As Config

Set X = New Config

X.PropertyValue("DateTime") = Now
X.PropertyValue("Version") = App.Major
X.PropertyValue("SayHello") = "Hello"

Debug.Print X.PropertyValue("DateTime")
Debug.Print X.PropertyValue("Version")
Debug.Print X.PropertyValue("SayHello")
Debug.Print X.PropertyValue("Invalid")

X.SaveFile "C:\Temp\TestFile.Cfg"

Set X = Nothing
Set X = New Config

X.LoadFile "C:\Temp\TestFile.Cfg"

Debug.Print X.PropertyValue("DateTime")
Debug.Print X.PropertyValue("Version")
Debug.Print X.PropertyValue("SayHello")
Debug.Print X.PropertyValue("Invalid")
End Sub
<<<<<<<<<<<<<< Fin de Sub Main <<<<<<<<<<<<<<<<<

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_FlyKiller)