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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 198 fois - Téléchargée 37 fois

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

Ajouter un commentaire

Commentaires

Signaler
cs_jonathan2002
Messages postés
28
Date d'inscription
dimanche 22 décembre 2002
Statut
Membre
Dernière intervention
15 mai 2004
c trop long, ya bien plus court ! 3/10
Signaler
cs_Alex001
Messages postés
32
Date d'inscription
mercredi 25 juillet 2001
Statut
Membre
Dernière intervention
20 janvier 2009
moi je trouve ca bien , pour les commentaire , les autres n'ont qu'a lire le code y a pas besoins de commentaire avec ce que tu as deja ecrit.

continue @+
Signaler
cs_Nestor
Messages postés
182
Date d'inscription
mardi 8 janvier 2002
Statut
Membre
Dernière intervention
2 octobre 2012
pas de commentaire + pas zip = 2/10
Signaler
Noiretulipe
Messages postés
165
Date d'inscription
mardi 21 janvier 2003
Statut
Membre
Dernière intervention
13 juillet 2008
cela m'a tout a fait l'air bien sympatique ....
Un zip serais le bien venu pour de fanéant come moi
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)