Savesetting et getsetting dans un fichier ini

Commenter

Contenu du snippet

Ce code est à copier dans un Module.
Il remplace les fonctions Vb SaveSetting,GetSetting,GetAllSetting,DeleteSetting
en gardant la même syntaxe. l'appel au anciennes fonction est toujours possible avec la syntaxe Vba.GetSetting , Vba.SaveSetting etc .

Une petite limitation tout de même avec GetAllSettings : la variable qui recevra le tableau devrat être un variant à l'exception de tout autre type y compris untableau

Exemple :

Dim Temp as Variant
Temp = GetAllSettings(App.Title, "General")

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
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Sub SaveSetting(AppName As String, Section As String, Key As String, Setting As String)
  Dim lRet As Long
  Dim Path As String
  Path = App.Path
  If Right(Path, 1) <> "\" Then
    Path = Path & "\"
  End If
  lRet = WritePrivateProfileString(Section, Key, Setting, Path & AppName & ".ini")
End Sub
Public Function GetSetting(AppName As String, Section As String, Key As String, Optional Default As String) As String
  Dim lRet As Long
  Dim Path As String
  Dim strTemp As String
  strTemp = Space(32567)
  Path = App.Path
  If Right(Path, 1) <> "\" Then
    Path = Path & "\"
  End If
  lRet = GetPrivateProfileString(Section, Key, Default, strTemp, Len(strTemp), Path & AppName & ".ini")
  lRet = InStr(strTemp, Chr$(0))
  If lRet = 0 Then
    GetSetting = ""
  Else
    GetSetting = Left(strTemp, lRet - 1)
  End If
End Function
Public Function GetAllSettings(AppName As String, Section As String) As Variant
  Dim lRet As Long
  Dim Path As String
  Dim strTemp As String
  Dim Table() As String
  Dim Table2() As String
  Dim iPnt As Integer
  Dim iPnt2 As Integer
  Dim iPosit As Integer
  strTemp = Space(32567)
  Path = App.Path
  If Right(Path, 1) <> "\" Then
    Path = Path & "\"
  End If
  
  lRet = GetPrivateProfileSection(Section, strTemp, Len(strTemp), Path & AppName & ".ini")
  iPnt = 0
  'For Redim+Preserve tables only the las index can be changed
  If Left(strTemp, 2) = Chr$(0) & Chr$(0) Then
    Exit Function
  End If
  Do While Left(strTemp, 1) <> Chr$(0)
    ReDim Preserve Table(1, iPnt)
    iPosit = InStr(strTemp, "=")
    Table(0, iPnt) = Left$(strTemp, iPosit - 1)
    strTemp = Mid$(strTemp, iPosit + 1)
    iPosit = InStr(strTemp, Chr$(0))
    Table(1, iPnt) = Left$(strTemp, iPosit - 1)
    strTemp = Mid$(strTemp, iPosit + 1)
    iPnt = iPnt + 1
  Loop
  ReDim Table2(iPnt - 1, 1)
  For iPnt2 = 0 To iPnt - 1
    Table2(iPnt2, 0) = Table(0, iPnt2)
    Table2(iPnt2, 1) = Table(1, iPnt2)
  Next
  GetAllSettings = Table2
End Function
Public Function DeleteSetting(AppName As String, Section As String, Optional Key As String)
  Dim lRet As Long
  Dim Path As String
  Path = App.Path
  If Right(Path, 1) <> "\" Then
    Path = Path & "\"
  End If
  If Key = "" Then
    lRet = WritePrivateProfileString(Section, vbNullString, vbNullString, Path & AppName & ".ini")
  Else
    lRet = WritePrivateProfileString(Section, Key, vbNullString, Path & AppName & ".ini")
  End If
End Function

Conclusion :


Un fois que vous avez créé le module, il suffit de l'ajouter à un code existant pour que les save/getsetting et tutiquanti de votre projet ecrivent dans un fichier ini plutot que dans Base de registre

J'espère que cela aideras ceux qui comme moi sont nostalgique des fichiers ini

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