Acceder al Registro por WMI

A continuación muestro una forma de acceder al Registro de Windows a través de la WMI de Windows.
( Windows Management Instrumentation )

 

El ejemplo esta bastante explicado ( al menos eso creo ) y de todas formas arriba tenéis mi e-mail por si queréis alguna aclaración del ejemplo ( Además de tener abajo el Fichero Zip con el Ejemplo ).

En el ejemplo hay un formulario en el que hay un Control ComboBox, un TextBox y dos ListBox los cuales nos servirán para introducir y Recibir los Datos. También hay un Modulo que eh llamado Registry en el cual están los tipos, enumeraciones y funciones de acceso para poder leer y escribir datos en el Registro.

Si queréis mas información de esto visitad el sitio de Microsoft ya que yo saque la información de cómo hacer esto de la librería de MSDN. El sitio es el Siguiente:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_registry.asp

Si el enlace hubiera cambiado de dirección, realizar una Búsqueda indicando Win32_Registry y lo encontrareis.

Sin mucho mas que decir pasaremos al ejemplo:

El código del Formulario ( Form1 ) es el siguiente:

 

Option Explicit
Private Sub Command1_Click()
' Lo 1º antes de leer valores es asegurarnos de que los
' datos son correctos
If Tipos.Text = vbNullString Then
    MsgBox "Elija el Parametro del Listado"
    Exit Sub
End If

Dim P As RegistryParameter
Select Case Tipos.Text
Case "hKeyLocalMachine"
P = RegLocalMachine
Case "hKeyCurrentUser"
P = RegCurrentUser
Case "hKeyUsers"
P = RegUsers
Case "hKeyCurrentConfig"
P = RegCurrentConfig
Case "hKeyDynData"
P = RegDynData
Case Else
P = RegLocalMachine
End Select
' Para Leer Valores lo 1º que tenemos que hacer es
' Crear 2 Variables de Tipos
' 1ª Var de SubClaves
Dim SubClaves As RegistryKeysList
' 2ª Var de SubArboles
Dim SubArboles As RegistrySubFolderKeysList
' y ahora pasamos a las Instrucciones

' Establecemos SubClaves
SubClaves = Registry.ReadSubKeys(P, Nombre.Text)
' Establecemos SubArboles
SubArboles = Registry.ReadSubFolders(P, Nombre.Text)

Dim Man As Integer
SubClavesList.Clear
SubArbolesList.Clear

' Si hay SubClaves las ponemos en el Listado
If SubClaves.Count > 0 Then
    ' Lo podemos hacer asi
    ' For Man = LBound(SubClaves.SubKey) _
    ' To UBound(SubClaves.SubKey)
    ' Pero de esta manera es mas corto
    For Man = 0 To SubClaves.Count - 1
      SubClavesList.AddItem _
            SubClaves.SubKey(Man).NameKey
    Next
End If

' Si hay SubArboles los ponemos en el Listado
If SubArboles.Count > 0 Then
    ' Lo podemos hacer asi
    ' For Man = LBound(SubArboles.SubKey) _
    ' To UBound(SubArboles.SubKey)
    ' Pero de esta manera es mas corto
    For Man = 0 To SubArboles.Count - 1
      SubArbolesList.AddItem SubArboles.SubFolderKey(Man)
    Next
End If
End Sub

Private Sub Form_Load()
' Cuando se inicia la Aplicacion establecemos el tipo
' de Parametro hKeyLocalMachine Por defecto
Tipos.Text = Tipos.List(0)
End Sub

 

Y ahora el código del Modulo:

Option Explicit

'**************************************************************
' Objeto Relacionado con los Valores del Registro
'
'
'
'
'
'                                   By: Pol Florez Viciana
'**************************************************************
' Constantes de Referencia a Numeros
Private Const Cero = 0
Private Const Uno = 1
Private Const Dos = 2
Private Const Tres = 3
Private Const Cuatro = 4
Private Const Cinco = 5
Private Const Seis = 6
Private Const Siete = 7

Private Const DosPuntos As String * Uno = ":"
Private Const Barra As String * Uno = "/"
Private Const Contrabarra As String * Uno = "\"
Private Const Punto As String * Uno = "."

' Enumeracion de Parametros de Registro
' ( Inicio de Clave )
Public Enum RegistryParameter
    RegClassesRoot = &H80000000
    RegCurrentUser = &H80000001
    RegLocalMachine = &H80000002
    RegUsers = &H80000003
    RegCurrentConfig = &H80000005
    RegDynData = &H80000006
End Enum

' Enumeracion de Tipos de Claves que se pueden Crear
Public Enum RegistryKeyTypes
    RegSZ = Uno
    RegExpandSZ = Dos
    RegBINARY = Tres
    RegDWORD = Cuatro
    RegMultiSZ = Siete
End Enum

' Tipo devuelto por la Funcion ReadSubKeys
' ( Es una Parte de lo que devuelve ) = 1 SubKey
Public Type RegistryKey
    NameKey As String
    PathKey As String
    TypeKey As RegistryKeyTypes
End Type

' Tipo devuelto por la Funcion ReadSubKeys
Public Type RegistryKeysList
    SubKey() As RegistryKey     ' Varias SubKeys
    Count As Integer            ' Cuenta de SubKeys
End Type

' Tipo Devuelto por la Funcion ReadSubFolders
Public Type RegistrySubFolderKeysList
    SubFolderKey() As Variant
    SubFolderPath() As Variant
    Count As Integer
End Type

Public Function ReadSubKeys(RegParameter As RegistryParameter, _
                             ByVal RegKey As String) As RegistryKeysList
' Esta Funcion Devuelve un Array de Nombres
' de Subclaves de un Arbol del registro
On Error Resume Next
Dim ObjReg As Object
Dim ArrStrings() As Variant
Dim ArrTypes() As Variant
Static Man As Integer, Tempo As String

' Accedemos a un Objeto de Registro definido en la WMI
Set ObjReg = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
    ".\root\default:StdRegProv")

' Y llamamos a la Funcion EnumKey del Objeto
ObjReg.EnumValues RegParameter, RegKey, _
                  ArrStrings, ArrTypes

' Si no hay SubClaves Salimos
If UBound(ArrStrings) = Cero Then Exit Function

' De no ser asi establecemos los Valores a devolver
ReadSubKeys.Count = UBound(ArrStrings)
ReDim ReadSubKeys.SubKey(LBound(ArrStrings) To UBound(ArrStrings))

' Ahora vamos estableciendo Valores Clave por Clave
For Man = LBound(ArrStrings) To UBound(ArrStrings)
    ReadSubKeys.SubKey(Man).NameKey = ArrStrings(Man)
    ReadSubKeys.SubKey(Man).TypeKey = ArrTypes(Man)
    'Tempo = ParameterNameKey(RegParameter) & _
    '            Contrabarra & RegKey & _
    '            Contrabarra & ReadSubKeys.SubKey(Man).NameKey
    'ReadSubKeys.SubKey(Man).ValueKey = ReadKey(Tempo)
Next

' Por Ultimo descargamos el Objeto Creado al Principio
Set ObjReg = Nothing
End Function

Public Function ReadSubFolders(RegParameter As RegistryParameter, _
                               ByVal RegKey As String) _
                               As RegistrySubFolderKeysList
' Esta Funcion devuelve un Array de SubArboles de la
' Clave del Registro Indicada
On Error Resume Next
Dim ObjReg As Object
Dim arrSubKeys As Variant
Dim SubKey As Variant
Dim Cuenta As Integer

' Accedemos a un Objeto de Registro definido en la WMI
Set ObjReg = GetObject("winmgmts:" & _
    "{impersonationLevel=impersonate}!\\" & _
    ".\root\default:StdRegProv")

' Y llamamos a la Funcion EnumKey del Objeto
ObjReg.EnumKey RegParameter, RegKey, arrSubKeys

' Contamos todos los Valores Devueltos del Array
For Each SubKey In arrSubKeys
    If SubKey = vbNullString Then Exit For
    Cuenta = Cuenta + Uno
Next

' Si Cuenta = 0 Salimos porque no hay valores en esa
' Clave de Registro
If Cuenta = Cero Then Exit Function
' De no ser asi establecemos el valor de Count y
' redimensionamos el Array para ir estableciendo Valores
ReadSubFolders.Count = Cuenta
ReDim ReadSubFolders.SubFolderKey(Cero To Cuenta - Uno)

' A continuacion Leemos Valor por Valor y lo
' establecemos en el Array
Cuenta = Cero
For Each SubKey In arrSubKeys
    ReadSubFolders.SubFolderKey(Cuenta) = SubKey
    ReadSubFolders.SubFolderPath(Cuenta) = _
        ParameterNameKey(RegParameter) & Contrabarra & _
        RegKey & Contrabarra & SubKey
    Cuenta = Cuenta + Uno
Next

' Por Ultimo descargamos el Objeto Creado al Principio
Set ObjReg = Nothing
End Function


Public Function ExistKey(ByVal KeyPath As String) As Boolean
' Comprobar si existe una Clave en el Registro
On Error Resume Next
Dim D As Variant    ' Devuelve un Variant
Dim ObjRegistro As Object

' Creamos un Objeto de Registro
Set ObjRegistro = CreateObject("WScript.Shell")
' y accedemos a su valor
D = ObjRegistro.RegRead(KeyPath)

' Si hay un error es que la Clave no existe
If Err.Number = Cero Then ExistKey = True Else Exit Function

' Descargamos el Objeto
Set ObjRegistro = Nothing
End Function

Public Function ReadKey(ByVal KeyPath As String) As Variant
' Leer una Clave del Registro
On Error Resume Next
Dim ObjRegistro As Object

' Creamos un Objeto de Registro
Set ObjRegistro = CreateObject("WScript.Shell")

' y accedemos a su valor para Devolverlo como Resultado
ReadKey = ObjRegistro.RegRead(KeyPath)

' Descargamos el Objeto
Set ObjRegistro = Nothing
End Function

Public Function DeleteKey(ByVal KeyPath As String) As ErrObject
' Eliminar una Clave del Registro
On Error Resume Next
Dim ObjRegistro As Object

' Creamos un Objeto de Registro
Set ObjRegistro = CreateObject("WScript.Shell")

' y nos cargamos la Clave ( Exista o No )
ObjRegistro.RegDelete KeyPath

' Descargamos el Objeto
Set ObjRegistro = Nothing
' Si ha havido algun error lo sabremos ya que devolvemos
' como parametro el error que hayamos encontrado
Set DeleteKey = Err
End Function

Public Function CreateKey(KeyPath As String, _
                             KeyValue As Variant, _
                             RegType As RegistryKeyTypes) As ErrObject
' Crear una Nueva Clave en el Registro
On Error Resume Next
Dim D As String
Dim ObjRegistro As Object

' Creamos un Objeto de Registro
Set ObjRegistro = CreateObject("WScript.Shell")

' Miramos cual es el caso de RegType
Select Case RegType
    Case RegBINARY
        D = "REG_BINARY"
    Case RegDWORD
        D = "REG_DWORD"
    Case RegSZ
        D = "REG_SZ"
    Case RegMultiSZ
        D = "REG_MULTI_SZ"
    Case RegExpandSZ
        D = "REG_EXPAND_SZ"
End Select

' y ahora ponemos o Creamos la Clave en su sition
ObjRegistro.RegWrite KeyPath, KeyValue, D

' Descargamos el Objeto
Set ObjRegistro = Nothing
' si ha havido algun error lo sabremos porque
' lo devolvemos como valor
Set CreateKey = Err
End Function

Public Function CreateFolderKey(KeyPath As String) As ErrObject
' Crear una Nueva Rama en el Registro
On Error Resume Next
Dim D As String
Dim ObjRegistro As Object

' Creamos un Objeto de Registro
Set ObjRegistro = CreateObject("WScript.Shell")

' examinamos si el nuevo Arbol finaliza en contrabarra = "\"
If Right(KeyPath, Uno) = Contrabarra Then
    D = KeyPath
Else
    D = KeyPath & Contrabarra
End If

' para crear un arbol el RegType a de ser BINARY
ObjRegistro.RegWrite D, Uno, "REG_BINARY"

' Descargamos el Objeto
Set ObjRegistro = Nothing
' si ha havido algun error lo sabremos porque
' lo devolvemos como valor
Set CreateFolderKey = Err
End Function


Public Function ParameterNameKey(RegParameterA As RegistryParameter) As String
' Esta funcion nos servira para saber el Nombre del Parametro
' en la que se establecera o leera el/la arbol/Clave

If RegParameterA = RegClassesRoot Then
    ParameterNameKey = "HKEY_CLASSES_ROOT"
    Exit Function
End If
If RegParameterA = RegCurrentConfig Then
    ParameterNameKey = "HKEY_CURRENT_CONFIG"
    Exit Function
End If
If RegParameterA = RegCurrentUser Then
    ParameterNameKey = "HKEY_CURRENT_USER"
    Exit Function
End If
If RegParameterA = RegDynData Then
    ParameterNameKey = "HKEY_DYN_DATA"
    Exit Function
End If
If RegParameterA = RegLocalMachine Then
    ParameterNameKey = "HKEY_LOCAL_MACHINE"
    Exit Function
End If
If RegParameterA = RegUsers Then
    ParameterNameKey = "HKEY_USERS"
    Exit Function
End If
End Function

 

Seguro que este ejemplo le resuelve a mas de uno sus dudas.

 

Fichero con el código de ejemplo: PolFlo_Acceder_al_Registro_por_WMI.zip - 4,74 KB