Option Explicit
 
'Declaración de constantes
'****************************
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
 
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
 
'Declaración de las funciones api para el registro
'*************************************************
 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
       (ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal Reserved As Long, _
        ByVal lpClass As String, _
        ByVal dwOptions As Long, _
        ByVal samDesired As Long, _
        ByVal lpSecurityAttributes As Long, _
        phkResult As Long, _
        lpdwDisposition As Long) As Long
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
       (ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
 
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
       (ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As String, _
        lpcbData As Long) As Long
 
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
       (ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Long, _
        lpcbData As Long) As Long
 
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
       (ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As Long, _
        lpcbData As Long) As Long
 
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" _
        (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal Reserved As Long, _
         ByVal dwType As Long, _
         ByVal lpValue As String, _
         ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
         "RegSetValueExA" (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal Reserved As Long, _
         ByVal dwType As Long, _
         lpValue As Long, _
         ByVal cbData As Long) As Long
 
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" _
        (ByVal hKey As Long, _
         ByVal lpSubKey As String)
 
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" _
        (ByVal hKey As Long, _
         ByVal lpValueName As String)
 
 
'Funciones públicas para crear, eliminar, consultar los datos
'****************************************************************
' Función que elimina una clave especifica utilizando el Api RegDeleteKey
Public Function EliminarClave(clave As Long, Nombre_clave As String)
    Dim ret As Long
    ret = RegDeleteKey(clave, Nombre_clave)
End Function
' Función que elimina un dato utilizando el Api RegDeleteValue
Public Function EliminarValor(clave As Long, _
                              Nombre_clave As String, _
                              Nombre_valor As String)
       Dim ret As Long
       Dim Handle_clave As Long
 
       ' Abre la clave del registro
       ret = RegOpenKeyEx(clave, Nombre_clave, 0, KEY_ALL_ACCESS, Handle_clave)
       'Elimina el valor del registro
       ret = RegDeleteValue(Handle_clave, Nombre_valor)
       'Cierra la vlave del registro abierta
       RegCloseKey (Handle_clave)
End Function
 
' Función que crea una nueva Clave utilizando el Api RegCreateKeyEx
Public Function CrearNuevaClave(clave As Long, Nombre_clave As String)
 
    Dim Handle_clave As Long
    Dim ret As Long
 
    ret = RegCreateKeyEx(clave, _
                         Nombre_clave, 0&, vbNullString, _
                         REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, _
                         Handle_clave, ret)
 
    RegCloseKey (Handle_clave)
 
End Function
' Función que establece un nuevo valor mediante el Api SetValueEx
 
Public Function EstablecerValor(clave As Long, _
                                Nombre_clave As String, _
                                Nombre_valor As String, _
                                el_Valor As Variant, _
                                Tipo_Valor As Long)
 
 
       Dim ret As Long
       Dim Handle_clave As Long
 
       ret = RegOpenKeyEx(clave, Nombre_clave, 0, KEY_ALL_ACCESS, Handle_clave)
       ret = SetValueEx(Handle_clave, Nombre_valor, Tipo_Valor, el_Valor)
 
       RegCloseKey (Handle_clave)
 
End Function
' Función que consulta un dato del registro usando QueryValueEx
Public Function ConsultarValor(clave As Long, Nombre_clave As String, Nombre_valor As String)
 
       Dim Handle_clave As Long
       Dim valor As Variant
 
       Dim ret As Long
 
       ret = RegOpenKeyEx(clave, Nombre_clave, 0, KEY_ALL_ACCESS, Handle_clave)
 
       ret = QueryValueEx(Handle_clave, Nombre_valor, valor)
       ' REtorna el valor del registro a la función
       ConsultarValor = valor
       'Cierra la clave abierta del registro
       RegCloseKey (Handle_clave)
End Function
 
' Funciones privadas del módulo
Private Function SetValueEx(ByVal Handle_clave As Long, _
                            Nombre_valor As String, _
                            Tipo As Long, _
                            el_Valor As Variant) As Long
 
    Dim ret As Long
    Dim sValue As String
 
    Select Case Tipo
 
        ' Valor de tipo cadena
        Case REG_SZ
 
            sValue = el_Valor
            SetValueEx = RegSetValueExString(Handle_clave, _
                                             Nombre_valor, 0&, _
                                             Tipo, sValue, Len(sValue))
 
        'Valor Entero
        Case REG_DWORD
            ret = el_Valor
            SetValueEx = RegSetValueExLong(Handle_clave, Nombre_valor, 0&, Tipo, ret, 4)
        End Select
End Function
Private Function QueryValueEx(ByVal lhKey As Long, _
                              ByVal Name_Valor As String, _
                              el_Valor As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim Tipo As Long
    Dim ret_Valor As Long
    Dim dato As String
    On Error GoTo QueryValueExError
    lrc = RegQueryValueExNULL(lhKey, Name_Valor, 0&, Tipo, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5
    Select Case Tipo
        Case REG_SZ:
            dato = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, Name_Valor, 0&, Tipo, dato, cch)
If lrc = ERROR_NONE Then
                el_Valor = Left$(dato, cch)
Else
                el_Valor = Empty
End If
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, Name_Valor, 0&, Tipo, ret_Valor, cch)
            If lrc = ERROR_NONE Then el_Valor = ret_Valor
        Case Else
            lrc = -1
    End Select
QueryValueExExit:
    QueryValueEx = lrc
    Exit Function
QueryValueExError:
    Resume QueryValueExExit
End Function

MsgBox cRegistro.ConsultarValor(&H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\", "")