Nota:
Para ver la clase original del 18/Ago/98, pulsa este link
Este link te llevará a la revisión del 12/Jun/99
Este otro te llevará a la revisión del 22/Jun/2000 (4)
Este es el correspondiente a la revisión del 28/Dic/2001 (5)
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 FunctionEl 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 SubEjemplo 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 SubPulsa 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.