SAVESETTING ET GETSETTING DANS UN FICHIER INI

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