Fichier ini + fonctions sauve position + taille fenetre, mettre val vite,...

Commenter

Contenu du snippet

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

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 (AtomWare)