Este codigo lo pones en un modulo de clase, la mayor parte esta tomada de la pagina del guille, solo hice algunas modificaciones para que tuviera mas funcionalidades chequenla y si quisieran que hiciera algo mas solo diganme y le añadire la funcion, de todos modos esta clase la estoy actualizando muy constantementey espero poner actualizaciones muy seguido.
Código:
'----------------------------------------------------------- -------------------
' Clase para manejar ficheros INIs
' Permite leer secciones enteras y todas las secciones de un fichero INI
'
' Última revisión:&nb sp;&nb sp;&nb sp;&nb sp;&nb sp; (04/Abr/01)
'
'
' ©Guillermo 'guille' Som, 1997-2001
'
'
'Modificacion por Zitro: 31/Julio/2006
'Agregue las funciones:
'
'IniWriteSection
'IniGetValuesOnSection
'IniGetKeysOnSection
'IniGetLastKeyInSection
'IniGetLastValueInSection
'
'Me base en la funcion de IniGetSection para hacer las anteriores
'Ademas de que agregue una funcion api para solo agregar una seccion
'Sin valores dentro de la misma
'----------------------------------------------------------- -------------------
Option Explicit
Private sBuffer As String ' Para usarla en las funciones GetSection(s)
'--- Declaraciones para leer ficheros INI ---
' Leer todas las secciones de un fichero INI, esto seguramente no funciona en Win95
' Esta función no estaba en las declaraciones del API que se incluye con el VB
Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" _
(ByVal lpszReturnBuffer As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
' Leer una sección completa
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
' Leer una clave de un fichero INI
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
' Escribir una clave de un fichero INI (también para borrar claves y secciones)
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 WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" _
(ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public Sub IniDeleteKey(ByVal sIniFile As String, ByVal sSection As String, _
Optional ByVal sKey As String = "")
'----------------------------------------------------------- ---------------
' Borrar una clave o entrada de un fichero INI&nb sp; (16/Feb/99)
' Si no se indica sKey, se borrará la sección indicada en sSection
' En otro caso, se supone que es la entrada (clave) lo que se quiere borrar
'
' Para borrar una sección se debería usar IniDeleteSection
'
If Len(sKey) = 0 Then
' Borrar una sección
Call WritePrivateProfileString(sSection, 0&, 0&, sIniFile)
Else
' Borrar una entrada
Call WritePrivateProfileString(sSection, sKey, 0&, sIniFile)
End If
End Sub
Public Sub IniDeleteSection(ByVal sIniFile As String, ByVal sSection As String)
'----------------------------------------------------------- ---------------
' Borrar una sección de un fichero INI (04/Abr/01)
' Borrar una sección
Call WritePrivateProfileString(sSection, 0&, 0&, sIniFile)
End Sub
Public Function IniGet(ByVal sFileName As String, ByVal sSection As String, _
ByVal sKeyName As String, _
Optional ByVal sDefault As String = "") As String
'----------------------------------------------------------- ---------------
' Devuelve el valor de una clave de un fichero INI
' Los parámetros son:
' sFileName El fichero INI
' sSection La sección de la que se quiere leer
' sKeyName Clave
' sDefault Valor opcional que devolverá si no se encuentra la clave
'----------------------------------------------------------- ---------------
Dim ret As Long
Dim sRetVal As String
'
sRetVal = String$(255, 0)
'
ret = GetPrivateProfileString(sSection, sKeyName, sDefault, sRetVal, Len(sRetVal), sFileName)
If ret = 0 Then
IniGet = sDefault
Else
IniGet = Left$(sRetVal, ret)
End If
End Function
Public Sub IniWriteSection(ByVal sFileName As String, ByVal sSection As String)
Call WritePrivateProfileSection(sSection, "", sFileName)
End Sub
Public Sub IniWrite(ByVal sFileName As String, ByVal sSection As String, _
ByVal sKeyName As String, ByVal sValue As String)
'----------------------------------------------------------- ---------------
' Guarda los datos de configuración
' Los parámetros son los mismos que en LeerIni
' Siendo sValue el valor a guardar
'
Call WritePrivateProfileString(sSection, sKeyName, sValue, sFileName)
End Sub
Public Function IniGetSection(ByVal sFileName As String, _
ByVal sSection As String) As String()
'----------------------------------------------------------- ---------------
' Lee una sección entera de un fichero INI&nb sp; (27/Feb/99)
' Adaptada para devolver un array de string (04/Abr/01)
'
' Esta función devolverá un array de índice cero
' con las claves y valores de la sección
'
' Parámetros de entrada:
' sFileName Nombre del fichero INI
' sSection Nombre de la sección a leer
' Devuelve:
' Un array con el nombre de la clave y el valor
' Para leer los datos:
' For i = 0 To UBound(elArray) -1 Step 2
'  ; sClave = elArray(i)
'  ; sValor = elArray(i+1)
' Next
'
Dim i As Long
Dim j As Long
Dim sTmp As String
Dim sClave As String
Dim sValor As String
'
Dim aSeccion() As String
Dim n As Long
'
ReDim aSeccion(0)
'
' El tamaño máximo para Windows 95
sBuffer = String$(32767, Chr$(0))
'
n = GetPrivateProfileSection(sSection, sBuffer, Len(sBuffer), sFileName)
'
If n Then
'
' Cortar la cadena al número de caracteres devueltos
sBuffer = Left$(sBuffer, n)
' Quitar los vbNullChar extras del final
i = InStr(sBuffer, vbNullChar & vbNullChar)
If i Then
sBuffer = Left$(sBuffer, i - 1)
End If
'
n = -1
' Cada una de las entradas estará separada por un Chr$(0)
Do
i = InStr(sBuffer, Chr$(0))
If i Then
sTmp = LTrim$(Left$(sBuffer, i - 1))
If Len(sTmp) Then
' Comprobar si tiene el signo igual
j = InStr(sTmp, "=")
If j Then
sClave = Left$(sTmp, j - 1)
sValor = LTrim$(Mid$(sTmp, j + 1))
'
n = n + 2
ReDim Preserve aSeccion(n)
aSeccion(n - 1) = sClave
aSeccion(n) = sValor
End If
End If
sBuffer = Mid$(sBuffer, i + 1)
End If
Loop While i
If Len(sBuffer) Then
j = InStr(sBuffer, "=")
If j Then
sClave = Left$(sBuffer, j - 1)
sValor = LTrim$(Mid$(sBuffer, j + 1))
n = n + 2
ReDim Preserve aSeccion(n)
aSeccion(n - 1) = sClave
aSeccion(n) = sValor
End If
End If
End If
' Devolver el array
IniGetSection = aSeccion
End Function
Public Function IniGetValuesOnSection(ByVal sFileName As String, ByVal sSection As String) As String()
Dim i As Long
Dim j As Long
Dim sTmp As String
Dim sValor As String
'
Dim aSeccion() As String
Dim n As Long
'
ReDim aSeccion(0)
'
' El tamaño máximo para Windows 95
sBuffer = String$(32767, Chr$(0))
n = GetPrivateProfileSection(sSection, sBuffer, Len(sBuffer), sFileName)
'
If n Then
'
' Cortar la cadena al número de caracteres devueltos
sBuffer = Left$(sBuffer, n)
' Quitar los vbNullChar extras del final
i = InStr(sBuffer, vbNullChar & vbNullChar)
If i Then
sBuffer = Left$(sBuffer, i - 1)
End If
'
n = 0
' Cada una de las entradas estará separada por un Chr$(0)
Do
i = InStr(sBuffer, Chr$(0))
If i Then
sTmp = LTrim$(Left$(sBuffer, i - 1))
If Len(sTmp) Then
' Comprobar si tiene el signo igual
j = InStr(sTmp, "=")
If j Then
sValor = LTrim$(Mid$(sTmp, j + 1))
'
n = n + 1
ReDim Preserve aSeccion(n)
aSeccion(n) = sValor
End If
End If
sBuffer = Mid$(sBuffer, i + 1)
End If
Loop While i
If Len(sBuffer) Then
j = InStr(sBuffer, "=")
If j Then
sValor = LTrim$(Mid$(sBuffer, j + 1))
n = n
ReDim Preserve aSeccion(n)
aSeccion(n) = sValor
End If
End If
End If
' Devolver el array
IniGetValuesOnSection = aSeccion
End Function
Public Function IniGetKeysOnSection(ByVal sFileName As String, ByVal sSection As String) As String()
Dim i As Long
Dim j As Long
Dim sTmp As String
Dim sClave As String
'
Dim aSeccion() As String
Dim n As Long
'
ReDim aSeccion(0)
'
' El tamaño máximo para Windows 95
sBuffer = String$(32767, Chr$(0))
'
n = GetPrivateProfileSection(sSection, sBuffer, Len(sBuffer), sFileName)
'
If n Then
'
' Cortar la cadena al número de caracteres devueltos
sBuffer = Left$(sBuffer, n)
' Quitar los vbNullChar extras del final
i = InStr(sBuffer, vbNullChar & vbNullChar)
If i Then
sBuffer = Left$(sBuffer, i - 1)
End If
'
n = 0
' Cada una de las entradas estará separada por un Chr$(0)
Do
i = InStr(sBuffer, Chr$(0))
If i Then
sTmp = LTrim$(Left$(sBuffer, i - 1))
If Len(sTmp) Then
' Comprobar si tiene el signo igual
j = InStr(sTmp, "=")
If j Then
sClave = Left$(sTmp, j - 1)
'
n = n + 1
ReDim Preserve aSeccion(n)
aSeccion(n) = sClave
End If
End If
sBuffer = Mid$(sBuffer, i + 1)
End If
Loop While i
If Len(sBuffer) Then
j = InStr(sBuffer, "=")
If j Then
sClave = Left$(sBuffer, j - 1)
n = n + 1
ReDim Preserve aSeccion(n)
aSeccion(n) = sClave
End If
End If
End If
' Devolver el array
IniGetKeysOnSection = aSeccion
End Function
Public Function IniGetSections(ByVal sFileName As String) As String()
'----------------------------------------------------------- ---------------
' Devuelve todas las secciones de un fichero INI (27/Feb/99)
' Adaptada para devolver un array de string (04/Abr/01)
'
' Esta función devolverá un array con todas las secciones del fichero
'
' Parámetros de entrada:
' sFileName Nombre del fichero INI
' Devuelve:
' Un array con todos los nombres de las secciones
' La primera sección estará en el elemento 1,
' por tanto, si el array contiene cero elementos es que no hay secciones
'
Dim i As Long
Dim sTmp As String
Dim n As Long
Dim aSections() As String
'
ReDim aSections(0)
'
' El tamaño máximo para Windows 95
sBuffer = String$(32767, Chr$(0))
'
' Esta función del API no está definida en el fichero TXT
n = GetPrivateProfileSectionNames(sBuffer, Len(sBuffer), sFileName)
'
If n Then
' Cortar la cadena al número de caracteres devueltos
sBuffer = Left$(sBuffer, n)
' Quitar los vbNullChar extras del final
i = InStr(sBuffer, vbNullChar & vbNullChar)
If i Then
sBuffer = Left$(sBuffer, i - 1)
End If
'
n = 0
' Cada una de las entradas estará separada por un Chr$(0)
Do
i = InStr(sBuffer, Chr$(0))
If i Then
sTmp = LTrim$(Left$(sBuffer, i - 1))
If Len(sTmp) Then
n = n + 1
ReDim Preserve aSections(n)
aSections(n) = sTmp
End If
sBuffer = Mid$(sBuffer, i + 1)
End If
Loop While i
If Len(sBuffer) Then
n = n + 1
ReDim Preserve aSections(n)
aSections(n) = sBuffer
End If
End If
' Devolver el array
IniGetSections = aSections
End Function
Public Function IniGetLastKeyInSection(ByVal sFileName As String, ByVal sSection As String) As String
Dim s() As String
s = IniGetKeysOnSection(sFileName, sSection)
IniGetLastKeyInSection = s(UBound(s))
End Function
Public Function IniGetLastValueInSection(ByVal sFileName As String, ByVal sSection As String) As String
Dim s() As String
s = IniGetValuesOnSection(sFileName, sSection)
IniGetLastValueInSection = s(UBound(s))
End Function
Public Function AppPath(Optional ByVal ConBackSlash As Boolean = True) As String
' Devuelve el path del ejecutable (23/Abr/02)
' con o sin la barra de directorios
Dim s As String
'
s = App.Path
If ConBackSlash Then
If Right$(s, 1) <> "\" Then
s = s & "\"
End If
Else
If Right$(s, 1) = "\" Then
s = Left$(s, Len(s) - 1)
End If
End If
AppPath = s
End Function
Espero que les sirva, y gracias al guille por hacer tantas cosas utiles, y para los que digan que me fusile todo pues gran parte si pero es que se me hizo muy bueno el trabajo del gulle, ademas de que agregue varias funciones