mINI.bas

   1 Attribute VB_Name = "mINI"
   2 Option Explicit
   3 'Este modulo fué programado por Vladimir - TodoSV.com & SVCommunity.org
   4 Private Declare Function GetPrivateProfileSectionNames _
   5                 Lib "kernel32.dll" _
   6                 Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, _
   7                                                         ByVal nSize As Long, _
   8                                                         ByVal lpFileName As String) As Long
   9 Private Declare Function GetPrivateProfileString _
  10                 Lib "kernel32" _
  11                 Alias "GetPrivateProfileStringA" (ByVal lpSectionName As String, _
  12                                                   ByVal lpKeyName As Any, _
  13                                                   ByVal lpDefault As String, _
  14                                                   ByVal lpbuffurnedString As String, _
  15                                                   ByVal nBuffSize As Long, _
  16                                                   ByVal lpFileName As String) As Long
  17
  18 Public Function mINI_Obtener_Nombre_Secciones(Ruta_INI As String) As Collection
  19         'Lista
  20         '<EhHeader>
  21         On Error GoTo mINI_Obtener_Nombre_Secciones_Err
  22         '</EhHeader>
  23         Dim Secciones() As String
  24         Dim szBuf As String, lLen As Integer
  25         'Obtenemos los nombres de todas las secciones, vienen separadas por NullChar Chr(0)
  26 100     szBuf = String$(32767, vbNullChar) 'Creamos el buffer
  27 101     lLen = GetPrivateProfileSectionNames(szBuf, Len(szBuf), Ruta_INI) 'Obtenemos el largo del la lectura
  28 102     szBuf = Left$(szBuf, lLen) 'Cortamos lo innecesario
  29
  30 103     If szBuf = vbNullString Then
  31             Exit Function
  32         End If
  33
  34 104     Secciones = Split(szBuf, vbNullChar)
  35         Dim i As Long
  36         Dim a As Long
  37 105     a = UBound(Secciones) - 1
  38 106     Set mINI_Obtener_Nombre_Secciones = New Collection
  39
  40 107     For i = 0 To a
  41 108         mINI_Obtener_Nombre_Secciones.Add Secciones(i)
  42         Next
  43
  44         '<EhFooter>
  45         Exit Function
  46 mINI_Obtener_Nombre_Secciones_Err:
  47         Controlar_Error Erl, Err.Description, "P10XB.mINI.mINI_Obtener_Nombre_Secciones.Ref 7/6/2008 : 11:57:58"
  48         Resume Next
  49         '</EhFooter>
  50 End Function
  51
  52 Public Function mINI_Leer_Clave_de_Seccion(Ruta_INI As String, _
  53                                            nombre_Seccion As String, _
  54                                            nombre_Clave As String, _
  55                                            Optional Valor_si_no_existe As String = vbNullString) As String
  56         '<EhHeader>
  57         On Error GoTo mINI_Leer_Clave_de_Seccion_Err
  58         '</EhHeader>
  59         Dim Buffer As String * 32767
  60         Dim Lgt As Long
  61 100     Buffer = String$(32767, vbNullChar)
  62 101     Lgt = GetPrivateProfileString(nombre_Seccion, nombre_Clave, Valor_si_no_existe, Buffer, Len(Buffer), Ruta_INI)
  63
  64 102     If Lgt Then mINI_Leer_Clave_de_Seccion = Left$(Buffer, Lgt) Else mINI_Leer_Clave_de_Seccion = vbNullString
  65         '<EhFooter>
  66         Exit Function
  67 mINI_Leer_Clave_de_Seccion_Err:
  68         Controlar_Error Erl, Err.Description, "P10XB.mINI.mINI_Leer_Clave_de_Seccion.Ref 7/6/2008 : 11:57:58"
  69         Resume Next
  70         '</EhFooter>
  71 End Function