'Voila un code que tout le monde cherche, même si il est déjà posté, il y'a qq plus...
'Copiez tout dans un module. L'utilisation est decrite plus bas
Utilisation :
Dans form_load, ou qq part, du moment que ce soit executé avec les readini, writeini,...
mettez : INISetup app.path & "\" & "param.ini"
_______________
ECRIRE : WriteINI "Section", "Clé", "Valeur"
LIRE : Val = ReadINI ("Section", "Clé", "Valeur Défaut")
EFFACER CLé : DeleteKey "Section", "Clé"
EFFACER SECTION : DeleteSection "Section"
LIRE CLES : ReadKeys "Section"
LIRE SECTION : ReadSections
Sauvegarder positions, tailles d'une form :
IniPosSet Me ' ou IniPosSet Form1 (remplacer form1 par nom de la form
Remettre positions, taille : IniPosGet Me
Sauvegarder vite une info ( sans taper la section) :
QuickSet "Cle", "Valeur"
Lire vite une info ( sans taper la section, defaut)
Val = QuickGet ("Clé")
Source / Exemple :
Option Explicit
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Dim m_File As String, m_Buffer As Long
Function DeleteKey(iSection As String, iKeyName As String)
If m_Buffer = 0 Then
Err.Raise "670", "INIReadWrite", "Erreur : Taille Buffer"
ElseIf m_File = "" Then
Err.Raise "670", "INIReadWrite", "Fichier non configuré"
End If
WritePrivateProfileString iSection, iKeyName, vbNullString, m_File
End Function
Public Function DeleteSection(iSection As String)
If m_Buffer = 0 Then
Err.Raise "670", "INIReadWrite", "Erreur : taille buffer"
ElseIf m_File = "" Then
Err.Raise "670", "INIReadWrite", "Nom de fichier fichier non indiqué"
End If
WritePrivateProfileString iSection, vbNullString, vbNullString, m_File
End Function
Public Function INISetup(iniFile As String)
m_Buffer = 400
m_File = iniFile
End Function
Public Function ReadIni(iSection As String, iKeyName As String, Optional iDefault As String)
If m_Buffer = 0 Then
Err.Raise "670", "INIReadWrite", "Erreur : taille buffer"
ElseIf m_File = "" Then
Err.Raise "670", "INIReadWrite", "Nom de fichier non indiqué"
End If
Dim ret As String, NC As Long
ret = String(m_Buffer, 0)
NC = GetPrivateProfileString(iSection, iKeyName, iDefault, ret, m_Buffer, m_File)
If NC <> 0 Then
ret = Left$(ret, NC)
Else
ret = ""
End If
ret = Replace(ret, "%%&&Chr(13)&&%%", vbCrLf)
ReadIni = ret
End Function
Public Function ReadKeys(iSection As String)
If m_Buffer = 0 Then
Err.Raise "670", "INIReadWrite", "Erreur : taille buffer"
ElseIf m_File = "" Then
Err.Raise "670", "INIReadWrite", "Nom de fichier non indiqué"
End If
Dim ret As String, NC As Long
ret = String(m_Buffer, 0)
NC = GetPrivateProfileString(iSection, vbNullString, vbNullString, ret, m_Buffer, m_File)
If NC <> 0 Then
ret = Left$(ret, NC - 1)
End If
ReadKeys = ret
End Function
Public Function ReadSections()
If m_Buffer = 0 Then
Err.Raise "670", "INIReadWrite", "Erreur : taille buffer"
ElseIf m_File = "" Then
Err.Raise "670", "INIReadWrite", "Nom de fichier non indiqué"
End If
Dim ret As String, NC As Long
ret = String(m_Buffer, 0)
NC = GetPrivateProfileString(vbNullString, vbNullString, vbNullString, ret, m_Buffer, m_File)
If NC <> 0 Then
ret = Left$(ret, NC - 1)
End If
ReadSections = ret
End Function
Public Sub WriteIni(iSection As String, iKeyName As String, iValue As Variant)
If m_Buffer = 0 Then
Err.Raise "670", "INIReadWrite", "Erreur : taille buffer"
ElseIf m_File = "" Then
Err.Raise "670", "INIReadWrite", "Nom de fichier non indiqué"
End If
iValue = CStr(iValue)
iValue = Replace(iValue, vbCrLf, "%%&&Chr(13)&&%%")
WritePrivateProfileString iSection, iKeyName, CStr(iValue), m_File
End Sub
Public Function IniPosSet(FormName As Form)
On Error Resume Next
If FormName.WindowState = 0 Then
WriteIni FormName.Name, "Left", FormName.Left
WriteIni FormName.Name, "Top", FormName.Top
WriteIni FormName.Name, "Width", FormName.width
WriteIni FormName.Name, "Height", FormName.Height
End If
If FormName.WindowState <> 1 Then WriteIni FormName.Name, "WindowState", FormName.WindowState
End Function
Public Function IniPosGet(FormName As Form)
On Error Resume Next
If ReadIni(FormName.Name, "WindowState", 0) = 2 Then
FormName.Left = ReadIni(FormName.Name, "Left")
FormName.Top = ReadIni(FormName.Name, "Top")
FormName.width = ReadIni(FormName.Name, "Width")
FormName.Height = ReadIni(FormName.Name, "Height")
FormName.WindowState = 2
Else
FormName.Left = ReadIni(FormName.Name, "Left")
FormName.Top = ReadIni(FormName.Name, "Top")
FormName.width = ReadIni(FormName.Name, "Width")
FormName.Height = ReadIni(FormName.Name, "Height")
FormName.WindowState = 0
End If
End Function
Public Function QuickSet(kKey As String, kVal As String)
On Error Resume Next
WriteIni "APP.GLOBAL", kKey, kVal
End Function
Public Function QuickGet(kKey As String) As String
On Error Resume Next
QuickGet = ReadIni("APP.GLOBAL", kKey)
End Function
Conclusion :
Voila, n'hesitez pas a noter la source et à mettre un commentaire.
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.