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 <<<<<<<<<<<<<<<<<
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.