Esta es una revisión/ampliación de la clase cQueryReg publicada el 18/Ago/98.
Lo que hay de nuevo en esta nueva
versión es que se pueden enumerar las subclaves de una clave
indicada o los valores de una clave del registro.
Por tanto sólo se mostrará el código de estas nuevas
funciones, además voy a poner un par de ejemplos de cómo
usarla, uno de los ejemplos servirá para saber las conexiones
del acceso telefónico a redes disponibles para poder
conectarnos, el otro lo que hará será mostrar las subclaves que
tiene una clave determinada y seleccionando una de esas
subclaves, mostrar los valores contenidos en ella, de esta forma
podremos saber, por ejemplo, que programas se ejecutan al
iniciarse Windows, etc.
Para un futuro no muy lejano, ampliaré la clase para que pueda
guardar el contenido de una clave con sus subclaves en un fichero
REG, también habrá una función o método para lo contrario, es
decir: indicarle un fichero REG y asignar esos valores al
registro.
Vamos a ver las nuevas funciones y
los ejemplos.
Como creo que con los comentarios que tienen habrá suficiente,
te muestro sólo el código, después viendo en el código de
ejemplo cómo se usan, tendrás la información necesaria, al
menos eso espero, pero
si quieres hacer algún comentario o
necesitas aclaración, escribeme y lo pondré en esta página para que el resto del
personal se entere...
'
Public Function EnumKeys(colKeys() As String, ByVal sKey As String) As Boolean
'----------------------------------------------------------------------
'Enumera todas las subclaves de la clave indicada en sKey (12/Oct/98)
'
'Parámetros:
' colKeys() Array unidimensional que contendrá las claves halladas
' sKey Clave completa de la que se quiere la información
'
'Devolverá True si todo va bien
'
'Revisado para Array y buen funcionamiento (espero) (14/Oct/98)
'----------------------------------------------------------------------
Dim dwIndex As Long
Dim ret As Long
Dim hKey2 As Long
Dim hKey As Long
Dim lpName As String
Dim lpftLastWriteTime As FILETIME
Dim colItems As Long
Dim lSize As Long
Dim SubKeysNum As Long
Dim MaxSubKeyLen As Long
Dim numValues As Long
Dim MaxValueNameLen As Long
Dim MaxDataLen As Long
colItems = 0
ReDim colKeys(0)
'Si se pasa una cadena en sKey, esta función la convierte
'en un valor válido para la clave principal
hKey = ParseKey(sKey, hKey)
'Abrir la clave indicada
ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_ENUMERATE_SUB_KEYS, hKey2)
EnumKeys = True
'Si todo va bien (se ha podido abrir la clave)
If ret = ERROR_SUCCESS Then
'Obtener información de la clave y datos, devolverá:
'SubKeysNum Número de subclaves
'MaxSubKeyLen Tamaño máximo de nombre de clave
'numValues Número de valores en esta clave
'MaxValueNameLen Tamaño máximo del nombre del valor
'MaxDataLen Tamaño máximo de los datos
ret = RegQueryInfoKey(hKey2, 0&, 0&, 0&, SubKeysNum, MaxSubKeyLen, _
0&, numValues, MaxValueNameLen, _
MaxDataLen, 0&, lpftLastWriteTime)
'Se empieza desde cero
For dwIndex = 0 To SubKeysNum
lSize = MaxSubKeyLen
lpName = String$(lSize + 1, 0)
'Sólo nos interesa los nombres de las subclaves
ret = RegEnumKeyEx(hKey2, dwIndex, lpName, lSize, _
0&, 0&, 0&, lpftLastWriteTime)
If ret = ERROR_MORE_DATA Or ret = ERROR_SUCCESS Then
'Redimensionar el array
colItems = colItems + 1
ReDim Preserve colKeys(colItems)
'lSize tiene el número de caracteres devuelto,
'sin incluir el CHR$(0) del final
colKeys(colItems) = Left$(lpName, lSize)
End If
Next
Else
EnumKeys = False
End If
'Cerrar la clave abierta
ret = CloseKey(hKey2)
End Function
'
Public Function EnumValues(ByRef colKeys() As String, ByVal sKey As String) As Boolean
'----------------------------------------------------------------------
'Enumera todos los valores de la clave indicada en sKey (12/Oct/98)
'
'Parámetros:
' colKeys() Array unidimensional que contendrá las claves halladas
' En este array se almacena el nombre del valor y a
' continuación el valor en si, por tanto hay que tener
' esto en cuenta a la hora de recuperar la información.
' Ver el ejemplo de cómo usarla un poco más abajo.
' sKey Clave completa de la que se quiere la información
'
'Devolverá True si todo va bien
'
'Revisado para Array y buen funcionamiento (espero) (14/Oct/98)
'----------------------------------------------------------------------
'Para recuperar la información de colKeys(), hacer esto:
'
'If .EnumValues(colKeys(), sKey) Then
' For i = 1 To UBound(colKeys) Step 2
' 'colKeys(i) será el nombre
' 'colKeys(i + 1) será el valor o dato almacenado
' Next
'End If
'----------------------------------------------------------------------
'
Dim dwIndex As Long
Dim ret As Long
Dim hKey2 As Long
Dim hKey As Long
Dim lpName As String
Dim lpftLastWriteTime As FILETIME
Dim retDT As eHKEYDataType
Dim lSize As Long
Dim sData As String
Dim aData() As Byte
Dim lDWord As Long
Dim i As Long
Dim colItems As Long
Dim SubKeysNum As Long
Dim MaxSubKeyLen As Long
Dim numValues As Long
Dim MaxValueNameLen As Long
Dim MaxDataLen As Long
'Si se pasa una cadena en sKey, esta función la convierte
'en un valor válido para la clave principal
hKey = ParseKey(sKey, hKey)
'Abrir la clave indicada
ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_QUERY_VALUE, hKey2)
'Valores por defecto
EnumValues = True
ReDim aData(0)
lDWord = 0
sData = ""
'Inicializar el array
colItems = 0
ReDim colKeys(colItems)
'Si todo va bien (se ha podido abrir la clave)
If ret = ERROR_SUCCESS Then
'Obtener la información de esta clave, devolverá:
'SubKeysNum Número de subclaves
'MaxSubKeyLen Tamaño máximo de nombre de clave
'numValues Número de valores en esta clave
'MaxValueNameLen Tamaño máximo del nombre del valor
'MaxDataLen Tamaño máximo de los datos
ret = RegQueryInfoKey(hKey2, 0&, 0&, 0&, SubKeysNum, MaxSubKeyLen, _
0&, numValues, MaxValueNameLen, _
MaxDataLen, 0&, lpftLastWriteTime)
lpName = String$(MaxValueNameLen + 1, 0)
'Hacer un bucle para el número de valores posibles
For dwIndex = 0 To numValues
lpName = String$(MaxValueNameLen + 1, 0)
'Llamarlo primero para saber el tipo de datos,
'el cual estará en retDT
ret = RegEnumValue(hKey2, dwIndex, 0&, 0&, 0&, retDT, 0&, 0&)
'la primera vez, cuando dwIndex = cero, devuelve ERROR_SUCCESS,
'pero después devuelve ERROR_MORE_DATA mientras haya datos.
If ret = ERROR_MORE_DATA Or ret = ERROR_SUCCESS Then
lSize = MaxDataLen
Select Case retDT
Case REG_SZ 'Datos de cadena
sData = String$(lSize, 0)
ret = RegEnumValue(hKey2, dwIndex, lpName, Len(lpName), 0&, retDT, ByVal sData, lSize)
sData = RTrimZero(sData)
lpName = RTrimZero(lpName)
ReDim Preserve colKeys(colItems + 2)
colKeys(colItems + 1) = lpName
colKeys(colItems + 2) = sData
colItems = colItems + 2
Case REG_DWORD
'Datos numéricos (long)
ret = RegEnumValue(hKey2, dwIndex, lpName, Len(lpName), 0&, retDT, lDWord, lSize)
sData = CStr(lDWord)
lpName = RTrimZero(lpName)
ReDim Preserve colKeys(colItems + 2)
colKeys(colItems + 1) = lpName
colKeys(colItems + 2) = sData
colItems = colItems + 2
'Case REG_BINARY
' 'Datos binarios
Case Else
'Tratarlo como Binary
If lSize Then
ReDim aData(lSize)
'Leer los datos binarios
ret = RegEnumValue(hKey2, dwIndex, lpName, Len(lpName), 0&, retDT, aData(0), lSize)
lpName = RTrimZero(lpName)
'Al estilo de como se muestra con RegEdit
sData = ""
For i = 0 To UBound(aData) - 1
sData = sData & Format$(Hex$(aData(i)), "00") & " "
Next
ReDim Preserve colKeys(colItems + 2)
colKeys(colItems + 1) = lpName
colKeys(colItems + 2) = sData
colItems = colItems + 2
End If
End Select
End If
Next
Else
EnumValues = False
End If
'Cerrar la clave abierta
ret = CloseKey(hKey2)
End Function
El formulario para conectarse leyendo la información del registro.
Esta utilidad lo que hace es buscar en el registro los diferentes accesos telefónicos a redes (Dial-Up Networking), mostrarlos en un combo, seleccionamos el que nos interese, en caso de que haya más de uno y después al pulsar en conectar se llama a RunDll32 para hacer la conexión, el código para poder hacer esto, me lo mandaron, pero no me decian el nombre y tampoco he encontrado el mail de quién lo hizo, así que doy las gracias a quién lo envió, que no es plan de anotarse puntos que no son de uno...
Veamos el aspecto del formulario en tiempo de diseño:
Ahora veamos el código que se usa al iniciarse el formulario, el cual llena el combo con las diferentes conexiones, obtenidas de la siguiente clave del registro: HKEY_USERS\.Default\RemoteAccess\Addresses
'
'--------------------------------------------------------------------------
'Ejemplo para conectarse usando Acceso Telefónico a Redes (09/Oct/98)
' (13/Oct/98)
'
'©Guillermo 'guille' Som, 1998
'--------------------------------------------------------------------------
Option Explicit
Private m_QR As cQueryReg 'Clase de manipulación del registro
Private colKeys() As String 'Array para guardar los nombres/contenidos
Private Sub cmdConectar_Click()
'Conectar usando el nombre de conexión indicado
Dim sConex As String
'Obtener el nombre de la conexión a usar
With cboConex
sConex = .List(.ListIndex)
End With
'Llamar a RunDll para conectar con la conexión indicada
Call Shell("RunDll32.exe rnaui.dll,RnaDial " & sConex, vbNormalFocus)
DoEvents
'Enviar una pulsación para conectar
'si esto te da problemas y lo quitas, tendrás que aceptar la conexión indicada
SendKeys "{Enter}", True
DoEvents
End Sub
Private Sub Form_Load()
'Leer del registro las conexiones disponibles
'y añadirlas al combo
'
Dim sKey As String
Dim i As Long
Set m_QR = New cQueryReg
'Borrar el contenido de colKeys
ReDim colKeys(0)
'Las conexiones disponibles (en Default)
sKey = "HKEY_USERS\.Default\RemoteAccess\Addresses"
'Leer los nombres de las conexiones disponibles
If m_QR.EnumValues(colKeys(), sKey) Then
'Es necesario el Step 2 ya que se lee el Nombre y el Contenido,
'aunque en este caso el contenido no nos interesa.
For i = 1 To UBound(colKeys) Step 2
cboConex.AddItem colKeys(i)
Next
If cboConex.ListCount Then
cboConex.ListIndex = 0
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Un poco de limpieza...
Set m_QR = Nothing
Set Form1 = Nothing
End Sub
Ejemplo para leer las subclaves de una clave y/o los valores de una clave:
Lo que se hace en esta rutina es
cargar inicialmente los valores de la clave:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion, que
es donde está la información, entre otras, de que programas se
cargan al iniciarse Windows, esta clave se usa automáticamente
al seleccionar el checkbox y se asigna al textbox de la parte
superior que es donde puedes escribir la clave de la que quieres
listar las subclaves que tenga.
En el combo se incluirán esas subclaves y al seleccionar una de
ellas se mostrará el nombre y el valor contenido en el ListView.
Cuando se seleccione un valor del ListView, se mostrará en las
cajas de texto correspondientes, listas para ser modificada en el
caso de los datos o borrada en el caso de la subclave, aunque el
código para hacer esto no he querido ponerlo para que no metas
la pata si te pones a probar...
Veamos el formulario en tiempo de diseño y el código del formulario.
'
'--------------------------------------------------------------------------
'tEnumReg (14/Oct/98)
'Prueba para usar la enumeración de claves y valores del registro
'
'©Guillermo 'guille' Som, 1998
'--------------------------------------------------------------------------
Option Explicit
Private m_QR As cQueryReg 'Clase de manipulación del registro
Private colKeys() As String 'Array para guardar los nombres/contenidos
Private Sub Form_Load()
'
Dim sKey As String
Dim i As Long
Set m_QR = New cQueryReg
ReDim colKeys(0) As String
txtKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\explorer"
txtNombre = ""
txtDatos = ""
'Valores del TreeView
With lvwRun
.View = lvwReport
.ColumnHeaders.Add , "Name", "Nombre", 2600
.ColumnHeaders.Add , "Data", "Datos", 5500
'No permitir que se modifique la etiqueta
.LabelEdit = lvwManual
'Mostrar la información ordenada
.Sorted = True
.SortOrder = lvwAscending
.SortKey = 0
End With
'Esto enumera las sub-claves que hay en esta clave
sKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion"
If m_QR.EnumKeys(colKeys(), sKey) Then
For i = 1 To UBound(colKeys)
cboKeys.AddItem colKeys(i)
Next
cboKeys.ListIndex = 0
End If
End Sub
Private Sub cboKeys_Click()
Dim sKey As String
Dim lItem As Long
Dim i As Long
Dim itmX As ListItem
'Esto enumera los valores de esta clave
'sKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\"
sKey = Trim$(txtKey)
If Right(sKey, 1) <> "\" Then
sKey = sKey & "\"
End If
With cboKeys
sKey = sKey & .List(.ListIndex)
End With
'Borrar el contenido de colKeys
ReDim colKeys(0)
'Borrar el contenido del TreeView
lvwRun.ListItems.Clear
If m_QR.EnumValues(colKeys(), sKey) Then
lItem = 1
For i = 1 To UBound(colKeys) Step 2
If Len(colKeys(i)) Then
Set itmX = lvwRun.ListItems.Add(lItem, "k" & colKeys(i), colKeys(i))
itmX.SubItems(1) = colKeys(i + 1)
lItem = lItem + 1
End If
Next
If lvwRun.ListItems.Count Then
With lvwRun
.SelectedItem = .ListItems(1)
If Len(.SelectedItem.Text) Then
Set itmX = .ListItems("k" & .SelectedItem.Text)
End If
txtNombre = itmX.Text
txtDatos = itmX.SubItems(1)
End With
End If
End If
End Sub
Private Sub chkCurrentVersion_Click()
Dim sKey As String
Dim i As Long
If chkCurrentVersion.Value Then
ReDim colKeys(0)
'Esto enumera las sub-claves que hay en esta clave
sKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion"
txtKey = sKey
If m_QR.EnumKeys(colKeys(), sKey) Then
For i = 1 To UBound(colKeys)
cboKeys.AddItem colKeys(i)
Next
If cboKeys.ListCount Then
cboKeys.ListIndex = 0
End If
End If
End If
End Sub
Private Sub cmdAsignar_Click()
'No implementado en el ejemplo...
'si quieres modificar algo, hazlo bajo tu responsabilidad
End Sub
Private Sub cmdBorrarRun_Click()
'No implementado en el ejemplo...
'si quieres borrar algo, hazlo bajo tu responsabilidad
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Un poco de limpieza...
Set m_QR = Nothing
Set tEnumReg = Nothing
End Sub
Private Sub lvwRun_Click()
'Mostrar el elemento "clickeado" en las cajas de texto (12/Oct/98)
Dim itmX As ListItem
With lvwRun
Set itmX = .ListItems(.SelectedItem.Text)
txtNombre = itmX.Text
txtDatos = itmX.SubItems(1)
End With
End Sub
Private Sub txtKey_KeyPress(KeyAscii As Integer)
Dim sKey As String
Dim i As Long
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
ReDim colKeys(0)
cboKeys.Clear
chkCurrentVersion.Value = 0
'Esto enumera las sub-claves que hay en esta clave
sKey = Trim$(txtKey)
If m_QR.EnumKeys(colKeys(), sKey) Then
For i = 1 To UBound(colKeys)
cboKeys.AddItem colKeys(i)
Next
If cboKeys.ListCount Then
cboKeys.ListIndex = 0
End If
End If
End If
End Sub
Pulsa este
link si quieres bajarte el listado completo de la clase así como
los ejemplos.
(QueryReg2.zip 16.4 KB)
Nota: Este ya no está disponible, bájate el último, (el link está arriba)
sí estarás más al día.
