FICHIER INI + FONCTIONS SAUVE POSITION + TAILLE FENETRE, METTRE VAL VITE,...

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