5/5 (4 avis)
Snippet vu 6 755 fois - Téléchargée 38 fois
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
1 juin 2003 à 15:28
13 avril 2003 à 10:49
continue @+
23 mars 2003 à 23:04
23 mars 2003 à 20:25
Un zip serais le bien venu pour de fanéant come moi
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.