Ejemplos usando el Api de windows para Visual basic

132 - Módulo para utilizar las funciones Api para el registro

Volver al Listado Api - Anterior - Siguiente

Ejemplo que permite crear, eliminar, consultar datos del registro de windows mediante el Api

Este módulo tiene cinco funciones que son las siguientes:

CrearNuevaClave, EstablecerValor, ConsultarValor, EliminarClave y EliminarValor

vista de las funciones del módulo

Nota: el módulo solo permite tratar datos de tipo Cadena y datos enteros Dword, para datos binarios por ejemplo no está implementado.

A continuación sigue el código a colocar en un módulo de clase llamado Registro , y al final un ejemplo para utilizarlos desde un formulario:

Código fuente en un Módulo de clase llamado Registro

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

Ejemplo para utilizar el módulo desde un Formulario

Colocar en un Form los siguientes controles mas o menos como está en la imagen:

vista del formulario de ejemplo para probar el módulo de clase

El primer TextBox ( para especificar la Clave ) se debe llamar: txtClave

El Text para especificar el Nombre del Valor : txtNameValor

El otro TextBox para el Dato: txtValor

Colocar cinco CommandButton: Command1 para Crear una nueva clave. Command2 para Establecer el valor. Command3 para Consultar. Command4 para eliminar una clave y Command5 para Eliminar un valor.

Código fuente del formulario

Private Const REG_SZ As Long = 1 Private Const REG_DWORD As Long = 4 Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const HKEY_CURRENT_USER = &H80000001 Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const HKEY_USERS = &H80000003 Dim OReg As Registro 'Crear nueva clave Private Sub Command1_Click() Call OReg.CrearNuevaClave(HKEY_CURRENT_USER, txtClave) End Sub 'Establecer Valor Private Sub Command2_Click() Call OReg.EstablecerValor(HKEY_CURRENT_USER, _ txtClave, _ txtNameValor, _ txtValor, REG_SZ) End Sub 'Consultar valor Private Sub Command3_Click() MsgBox OReg.ConsultarValor(HKEY_CURRENT_USER, txtClave, txtNameValor) End Sub 'Eliminar Clave Private Sub Command4_Click() Call OReg.EliminarClave(HKEY_CURRENT_USER, txtClave) End Sub 'Eliminar valor Private Sub Command5_Click() Call OReg.EliminarValor(HKEY_CURRENT_USER, txtClave, txtNameValor) End Sub Private Sub Form_Load() Set OReg = New Registro End Sub Private Sub Form_Unload(Cancel As Integer) Set OReg = Nothing End Sub

Constantes de error

Este es un listado de las constantes de error , que se pueden implementar con los ejempos anteriores para poder saber la descripción de un error al intentar modificar, eliminar , añadir entradas etc..

Nota: a la función GetRegErrorText que devuelve un string con el error, se le debe pasar como parámetro el valor de retorno en cada llamada a la función

Constantes

Const API_SUCCESS = 0& Const ERROR_BADDB = 1009& Const ERROR_BADKEY = 1010& Const ERROR_CANTOPEN = 1011& Const ERROR_CANTREAD = 1012& Const ERROR_CANTWRITE = 1013& Const ERROR_REGISTRY_RECOVERED = 1014& Const ERROR_REGISTRY_CORRUPT = 1015& Const ERROR_REGISTRY_IO_FAILED = 1016& Const ERROR_NOT_REGISTRY_FILE = 1017& Const ERROR_KEY_DELETED = 1018& Const ERROR_NO_LOG_SPACE = 1019& Const ERROR_KEY_HAS_CHILDREN = 1020& Const ERROR_CHILD_MUST_BE_VOLATILE = 1021& Const ERROR_RXACT_INVALID_STATE = 1369&

Función

Public Function GetRegErrorText(lStatus As Long) As String Select Case lStatus Case ERROR_BADDB GetRegErrorText = "The configuration registry database " & _ "is corrupt." Case ERROR_BADKEY GetRegErrorText = "The configuration registry key is " & _ "invalid." Case ERROR_CANTOPEN GetRegErrorText = "The configuration registry key could " & _ "not be opened." Case ERROR_CANTREAD GetRegErrorText = "The configuration registry key could " & _ "not be read." Case ERROR_CANTWRITE GetRegErrorText = "The configuration registry key could " & _ "not be written." Case ERROR_REGISTRY_RECOVERED GetRegErrorText = "One of the files in the Registry " & _ "database had to be recovered " & _ "by use of a log or alternate copy. " & _ "The recovery was successful." Case ERROR_REGISTRY_CORRUPT GetRegErrorText = "The Registry is corrupt. The structure " & _ "of one of the files that contains " & _ "Registry data is corrupt, or the " & _ "system's image of the file in memory " & _ "is corrupt, or the file could not be " & _ "recovered because the alternate " & _ "copy or log was absent or corrupt." Case ERROR_REGISTRY_IO_FAILED GetRegErrorText = "An I/O operation initiated by the " & _ "Registry failed unrecoverably. " & _ "The Registry could not read in, or " & _ "write out, or flush, one of the files " & _ "that contain the system's image of " & _ "the Registry." Case ERROR_NOT_REGISTRY_FILE GetRegErrorText = "The system has attempted to load or " & _ "restore a file into the Registry, but the " & _ "specified file is not in a Registry " & _ "file format." Case ERROR_KEY_DELETED GetRegErrorText = "Illegal operation attempted on a " & _ "Registry key which has been marked " & _ "for deletion." Case ERROR_NO_LOG_SPACE GetRegErrorText = "System could not allocate the required " & _ "space in a Registry log." Case ERROR_KEY_HAS_CHILDREN GetRegErrorText = "Cannot create a symbolic link in a " & _ "Registry key that already " & _ "has subkeys or values." Case ERROR_CHILD_MUST_BE_VOLATILE GetRegErrorText = "Cannot create a stable subkey under a " & _ "volatile parent key." Case ERROR_RXACT_INVALID_STATE GetRegErrorText = "The transaction state of a Registry " & _ "subtree is incompatible with the " & _ "requested operation." End Select End Function

Enlaces relacionados

Buscar en Recursos vb