Ce code permet de lire et écrire dans les fichiers de configuration (INI ou INF) sans utilisation des API dédiés à celà.
Source / Exemple :
Function ChangeCaractere(ByVal sTarget As String, sSearch As String, sNew As String) As String
Dim p As Integer
Do
p = InStr(sTarget, sSearch)
If p Then
sTarget = Left(sTarget, p - 1) + sNew + Mid(sTarget, p + Len(sSearch))
End If
Loop While p
ChangeCaractere = sTarget
End Function
Public Function GetFile(Filename As String)
Dim a As Long
a = FreeFile()
Open Filename For Input As #a
GetFile = Input(LOF(a), a)
Close #a
End Function
Public Function GetFileExist(Filename As String) As Boolean
On Error GoTo Erreur
FileLen (Filename)
GetFileExist = True
Exit Function
Erreur:
GetFileExist = False
End Function
Public Function SetFile(Filename As String, Texte As String)
Open Filename For Output As #1
Print #1, Texte
Close #1
End Function
Public Function GetNumberFileLine(Filename As String)
Dim b As Long
Open Filename For Input As #1
While Not EOF(1)
Input #1, a$
b = b + 1
Wend
Close #1
GetNumberFileLine = b
End Function
Public Function GetFileLine(Filename As String, Line As Long)
Dim StrLigne As String, e As Long
Open Filename For Input As #1
Do While Not EOF(1)
e = e + 1
Line Input #1, StrLigne
If e = Line Then
GetFileLine = StrLigne
Exit Do
End If
Loop
Close #1
End Function
Public Function GetIni(Filename As String, Contener As String, Variable As String)
Dim c As Long, i As Long, o As Long, a As Long, y As Long, Resultat As String, Fichier As String
If GetFileExist(Filename) Then
For i = 1 To GetNumberFileLine(Filename)
If UCase(Mid(GetFileLine(Filename, i), 1, Len(Contener) + 2)) = UCase("[" & Contener & "]") Then
For o = i + 1 To GetNumberFileLine(Filename)
If Mid(GetFileLine(Filename, o), 1, 1) = "[" Or o = GetNumberFileLine(Filename) Then
For a = i To o
If UCase(Mid(GetFileLine(Filename, a), 1, Len(Variable) + 1)) = UCase(Variable) & "=" Then
Resultat = Mid(GetFileLine(Filename, a), 2 + Len(Variable), Len(GetFileLine(Filename, a)) - (1 + Len(Variable)))
Exit For
End If
Next a
Exit For
End If
Next o
Exit For
End If
Next i
End If
GetIni = Resultat
End Function
Public Function WriteIni(Filename As String, Contener As String, Variable As String, Value As String)
Dim ancien As String, c As String, i As Long, o As Long, a As Long, y As Long, Resultat As String, Fichier As String
If GetFileExist(Filename) Then
If GetFile(Filename) <> "" Then
For i = 1 To GetNumberFileLine(Filename)
If UCase(Mid(GetFileLine(Filename, i), 1, Len(Contener) + 2)) = UCase("[" & Contener & "]") Then
For o = i + 1 To GetNumberFileLine(Filename)
If Mid(GetFileLine(Filename, o), 1, 1) = "[" Or o = GetNumberFileLine(Filename) Then
For y = i To o - 1
If LCase(Mid(GetFileLine(Filename, y), 1, Len(Variable) + 1)) = LCase(Variable & "=") Then
c = c & Variable & "=" & Value & Chr(13) & Chr(10)
Else
c = c & GetFileLine(Filename, y) & Chr(13) & Chr(10)
End If
ancien = ancien & GetFileLine(Filename, y) & Chr(13) & Chr(10)
Next y
Resultat = ChangeCaractere(GetFile(Filename), ancien, c)
Exit For
End If
Next o
Exit For
ElseIf i = GetNumberFileLine(Filename) Then
Resultat = GetFile(Filename) & Chr(13) & Chr(10) & "[" & Contener & "]" & Chr(13) & Chr(10) & Variable & "=" & Value
End If
Next i
Else
Resultat = "[" & Contener & "]" & Chr(13) & Chr(10) & Variable & "=" & Value
End If
Else
Resultat = "[" & Contener & "]" & Chr(13) & Chr(10) & Variable & "=" & Value
End If
Call SetFile(Filename, Resultat)
End Function
Conclusion :
Code non commenté, réalisé il y a longtemps dans un but d'apprentissage.
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.