Cómo modificar los valores de las claves de registro en VB
'Te daré una clase de registro
Guárdala como archivo IRegister.CLA
VERSIÓN 1.0 CLASE
BEGIN
. p>MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Atributo VB_Name = "IRegister"
Atributo VB_GlobalNameSpace = False
Atributo VB_Creatable = Verdadero
Atributo VB_PredeclaredId = False
Atributo VB_Exposed = Verdadero
Atributo VB_Ext_KEY = "SavedWithClassBuilder6", "Sí"
Atributo VB_Ext_KEY = "Top_Level", "Sí"
Opción explícita
Función de declaración privada ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc como cadena, ByVal lpDst como cadena, ByVal nSize As Long) As Long
Declaración privada Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destino como cualquiera, Fuente como cualquiera, ByVal Longitud As Long)
'Estructuras Necesario para prototipos de registro
Tipo privado SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
Tipo de fin
Tipo privado FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
Tipo de fin
' máscaras para los tipos de acceso estándar predefinidos
Const privada SYNCHRONIZE = &H100000
Const privada READ_CONTROL = &H20000
Const privada SPECIFIC_RIGHTS_ALL = &HFFFF
Const privado STANDARD_RIGHTS_ALL =
&H1F0000
Const privada STANDARD_RIGHTS_READ = (READ_CONTROL)
Const privada STANDARD_RIGHTS_WRITE = (READ_CONTROL)
'Derechos de acceso específicos del registro
Const privada KEY_EVENT = &H1
Const privada KEY_QUERY_VALUE = &H1
Const privada KEY_SET_VALUE = &H2
Const privada KEY_CREATE_SUB_KEY = &H4
Const privada KEY_ENUMERATE_SUB_KEYS = &H8
Const privada KEY_NOTIFY = &H10
Const privada KEY_CREATE_LINK = &H20
Const privada KEY_READ = ((STANDARD_RIGHTS_READ o KEY_QUERY_VALUE o KEY_ENUMERATE_SUB_KEYS o KEY_NOTIFY) y (no SYNCHRON IZE ))
Const privada KEY_WRITE = ((STANDARD_RIGHTS_WRITE o KEY_SET_VALUE o KEY_CREATE_SUB_KEY) y (no SYNCHRONIZE))
Const privada KEY_EXECUTE = (KEY_READ)
Privada Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL O KEY_QUERY_VALUE O KEY_SET_VALUE O KEY_CREATE_SUB_KEY O KEY_ENUMERATE_SUB_KEYS O KEY_NOTIFY O KEY_CREATE_LINK) Y (No SYNCHRONIZE))
'Opciones de abrir/crear
Const privado REG_OPTION_NON _VOLATIL = 0&< / p>
Const privada REG_OPTION_VOLATILE = &H1
'Creación de clave/disposición abierta
Const privada REG_CREATED_NEW_KEY = &H1
Const privada REG_OPENED_EXISTING_KEY = &H2
'Definir códigos de gravedad
Const privada ERROR_SUCCESS = 0&
Const privada ERROR_ACCESS_DENIED = 5
Const privada ERROR_INVALID_DATA = 13&
Const privada ERROR_MORE_DATA = 234 ' dderror
Const privada
ERROR_NO_MORE_ITEMS = 259
'Tipo de valor
Const privada REG_NONE = (0) 'Sin tipo de valor
Const privada REG_SZ = (1) 'Cadena terminada en nulo Unicode
Const privada REG_EXPAND_SZ = (2) 'Cadena terminada en nulo Unicode con var de entorno
Const privada REG_BINARY = (3) 'Binario de forma libre
Const privada REG_DWORD = (4) 'Número de 32 bits
Const privada REG_DWORD_LITTLE_ENDIAN = (4) 'Número de 32 bits (igual que REG_DWORD)
Const privada REG_DWORD_BIG_ENDIAN = (5) '32 -número de bits
Const privada REG_LINK = (6) 'Enlace simbólico (unicode)
Const privada REG_MULTI_SZ = (7) 'Múltiples cadenas Unicode
Const privada REG_RESOURCE_LIST = (8) 'Lista de recursos en el mapa de recursos
Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Lista de recursos en la descripción del hardware
Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10)
'Declaración de registro
Función de declaración privada RegRemoveKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey siempre, ByVal lpSubKey como cadena) Siempre
Función de declaración privada RegRemoveValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey siempre, ByVal lpValueName como cadena) mientras
Función de declaración privada RegOpenKeyEx Lib "advapi32.dll" Alias " RegOpenKeyExA" (
ByVal hKey Mientras, ByVal lpSubKey Como Cadena, ByVal ulOptions Mientras, ByVal samDesired Mientras, phkResult Mientras) Mientras
Función de declaración privada RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Función de declaración privada RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reservado Mientras, ByVal lpClass Como cadena, ByVal dwOptions Mientras, ByVal samDesired Mientras, lpSecurityAttributes Como SECURITY_ATTRIBUTES, phkResult Mientras, lpdwDisposition Mientras) Mientras
Función de declaración privada RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Tenga en cuenta que si declara el parámetro lpData como String, debe pasarlo por valor
Función de declaración privada RegSetValueExStr Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData. Como cadena, ByVal cbData As Long) As Long
Función de declaración privada RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reservado As Long, ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Función de declaración privada RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As
Largo, ByVal lpValueName Como cadena, ByVal Reservado Mientras, ByVal dwType Mientras, szData Como Byte, ByVal cbData Mientras) Como largo
Función de declaración privada RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA " ( ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Tenga en cuenta que si declara el parámetro lpData como Cadena, debe pasarlo por valor.
Función de declaración privada RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Función de declaración privada RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Función de declaración privada RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData Como byte, ByRef lpcbData As Long) As Long
Función de declaración privada RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Función de declaración privada RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcb
Nombre como largo, ByVal lpReserved como largo, ByVal lpClass como cadena, lpcbClass como largo, lpftLastWriteTime como FILETIME) como largo
Función de declaración privada RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey Mientras, ByVal dwIndex Mientras, ByVal lpValueName Como cadena, lpcbValueName Mientras, ByVal lpReserved Mientras, ByVal lpType Mientras, ByVal lpData Mientras, ByVal lpcbData Mientras) Mientras
Función de declaración privada RegEnumValueStr Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey mientras, ByVal dwIndex mientras, ByVal lpValueName como cadena, lpcbValueName mientras, ByVal lpReserved mientras, lpType mientras, ByVal lpData como cadena, lpcbData mientras) As Long
Función de declaración privada RegEnumValueLong Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Función de declaración privada RegEnumValueByte Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName Como cadena, lpcbValueName como largo, ByVal lpReserved como largo, lpType como largo, lpData como byte, lpcbData como largo) como largo
Función de declaración privada RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" ( ByVal hKey como larga, ByVal lpClass como cadena, lpcbClass como larga, ByVal lpReserved como larga, lpcSubKeys como larga, lpcbMaxSubKeyLen como larga, lpcbMaxClassLen como larga, lpcValues como larga, lpcbMaxV
alueNameLen Mientras, lpcbMaxValueLen Mientras, lpcbSecurityDescriptor Mientras, lpftLastWriteTime Como Cualquiera) Mientras
Función de declaración privada RegCloseKey Lib "advapi32.dll" (ByVal hKey Mientras) Mientras
Public Enum RegHeadKeyConstants
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
Enumeración final
Enumeración pública RegValueTypeConstants
regNone = REG_NONE
regString = REG_SZ
regExpandString = REG_EXPAND_SZ
regBinary = REG_BINARY
regDWORD = REG_DWORD
regDWORDLittleEndian = REG_DWORD_LITTLE_ENDIAN
regDWORDBigEndian = REG_DWORD_BIG_ENDIAN
regLink = REG_LINK
regMultiString = REG_MULTI_SZ
regResourceList = REG_RESOURCE_LIST
regFullResourceDescriptor = REG_FULL_RESOURCE_DESCRIPTOR
regResourceRequirementsList = REG_RESOURCE_REQUIREMENTS_LIST
End Enum
Clave CH privada siempre
CH_RT privada siempre
Función privada SwapEndian(ByVal dw As Long) As Long
CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw ) + 1, 1
CopiaMemoria ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
CopiaMemoria SwapEndia
n, ByVal VarPtr(dw) + 3, 1
Función final
Función privada ExpandEnvStr(sData As String) As String
Dim c As Long, s As String
' Obtiene la longitud
s = "" ' Necesario para sortear la limitación de Windows 95
c = ExpandEnvironmentStrings(sData, s, c)
' Expandir la cadena
s = String$(c - 1, 0)
c = ExpandEnvironmentStrings(sData, s, c)
ExpandEnvStr = s
Función final
Sub CheckRegErr()
Si CHKey = 0 Entonces
Err.Raise 1500, "Registro", "El registro no está abierto".
End If
End Sub
Property Get Handle() As OLE_HANDLE
Atributo Handle.VB_UserMemId = 0
Handle = CHKey
Propiedad final
Función pública FreeRegister() siempre
Si CHKey < > 0 Entonces
FreeRegister = RegCloseKey(CHKey)
CHKey = 0
Finalizar si
Finalizar función
Función pública OpenRegister(hKey como RegHeadKeyConstants, subclave opcional como cadena) siempre
Dim lCreate As Long, tSA As SECURITY_ATTRIBUTES
Dim rt As Long
FreeRegister
rt = RegCreateKeyEx(hKey, SubKey, 0, "", REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, tSA, CHKey, lCreate)
OpenRegister = rt 'set valor de retorno
CH_RT = rt
Si rt Entonces
Err.Raise 26001, "Registro", "Error al abrir el registro.
"
Else
OpenRegister = True
Finalizar si
Finalizar función
Función pública RemoveRegKey(hKey As RegHeadKeyConstants, Subclave como cadena) mientras sea largo
RemoveRegKey = RegRemoveKey(hKey, SubKey)
Función final
Función pública RemoveRegValue (Nombre de valor opcional como cadena) Mientras sea largo
CheckRegErr
RemoveRegValue = RegRemoveValue(CHKey, ValueName)
Función final
Función pública EnumValues(ByRef sKeyNames() como cadena, ByRef iKeyCount As Long) Como booleano
CheckRegErr
Dim lResult As Long
Dim sName As String
Dim lNameSize As Long
Dim sData As String
Dim lIndex Mientras
Dim cJunk Mientras
Dim cNameMax Mientras
Dim ft como moneda
' Registrar "EnterEnumerateValues"
iKeyCount = 0
Borrar sKeyNames()
lIndex = 0
lResult = CH_RT
Si (lResult = ERROR_SUCCESS) Entonces
' Registra "OpenedKey:" & m_hClassKey & "," & m_sSectionKey
lResult = RegQueryInfoKey(CHKey, "", cJunk, 0, _
cJunk, cJunk, cJunk, cJunk, _
cNameMax, cJunk, cJunk, ft)
Do While lResult = ERROR_SUCCESS
'Establecer espacio en el buffer
lNameSize = cNameMax + 1
sName = String$(lNameSize, 0)
Si (lNameSize = 0) Entonces lNameSize = 1
' Registra "Solicitando el siguiente valor"
'Obtener nombre del valor:
lResult = RegEnumValue(CHKey, lIndex, sName, lNameSize, _
0&, 0&, 0&, 0&)
' Iniciar sesión " RegEnumValue devolvió: " & lResult
If (lResult = ERROR_SUCCESS) Then
' Aunque en teoría también puedes recuperar el valor real
' y escribirlo aquí, Descubrí que siempre (en última instancia) daba como resultado
' un GPF, en Win95 y NT ¿Por qué? ¿Alguien puede ayudar?
sName = Left$(sName, lNameSize)
' Registrar "Valor enumerado:" & sName
iKeyCount = iKeyCount + 1
ReDim Preserve sKeyNames(1 a iKeyCount) como cadena
sKeyNames (iKeyCount) = sName
Finalizar si
lIndex = lIndex + 1
Bucle
Finalizar si
' Registrar "Salir de enumerar valores"
EnumValues = True
Función de salida
EnumValuesError:
Err.Raise vbObjectError + 1048 + 26003, "Registro", Err.Description
Función de salida
Función final
Función pública EnumSections(ByRef sSect() como cadena, ByRef iSectCount como larga ) Como booleano
CheckRegErr
Dim lResult As Long
Dim dwReserved As Long
Dim szBuffer como cadena
Atenuar lBuffSize durante todo el tiempo
Atenuar lIndex durante todo el tiempo
Atenuar lType durante todo el tiempo
Atenuar sCompKey como cadena
Atenuar iPos durante todo el tiempo
En caso de error, vaya a EnumSectionsError
iSectCount = 0
Borrar sSect
'
lIndex = 0
lResult = CH_RT
Do While lResult = ERROR_SUCCESS
'Establecer espacio en el buffer
szBuffer = String$(255, 0)
lBuffSize = Len (szBuffer)
'Obtener el siguiente valor
lResult = RegEnumKey(CHKey, lIndex, szBuffer, lBuffSize)
Si (lResult = ERROR_SUCCESS) Entonces
iSectCount = iSectCount + 1
ReDim Preserve sSect(1 To iSectCount) Como Cadena
iPos = InStr(szBuffer, Chr$(0))
Si (iPos > 0) Entonces
sSect(iSectCount) = Izquierda(szBuffer, iPos - 1)
Si no
sSect(iSectCount) = Izquierda (szBuffer, lBuffSize)
Finalizar si
Finalizar si
lIndex = lIndex + 1
Bucle
EnumSections = True
Salir de la función
EnumSectionsError:
Err.Raise vbObjectError + 1048 + 26002, "Registro", Err.Description
Salir de la función
Finalizar función
Función pública ValueExist(Valor opcional como cadena) como booleano
Dim lenData As Long, rt As Long, rgtype As Long
rt = RegQueryValueEx(CHKey, ValueName, 0, rgtype, ByVal vbNullString, lenData)
Si rt = 0 entonces
ValueExist = True
Else
ValueExist = False
Finalizar si
Finalizar función
Función pública ReadRegType(Op
tional ValueName As String) As RegValueTypeConstants
CheckRegErr
Dim l As Long, rt As Long, rgtype As Long
rt = RegQueryValueEx(CHKey, ValueName, 0 , rgtype, ByVal vbNullString, l)
ReadRegType = rgtype
Función final
Función pública ReadRegValue (ValueName opcional como cadena, ValueType opcional como RegValueTypeConstants)
CheckRegErr
Dim lenData As Long, rt As Long, rgtype As Long
Dim Str As String, dw As Long, bin() As Byte
rt = RegQueryValueEx(CHKey, ValueName, 0, rgtype, ByVal vbNullString, lenData)
Si rt y rt <> ERROR_MORE_DATA Entonces
Err.Raise rt, "Register" , "No puedo leer.
" & vbCrLf & "Número de error: " & rt
Salir de la función
Fin si
ValueType = rgtype ' devuelve el tipo del valor
Seleccione Caso rgtype
Caso REG_SZ, REG_MULTI_SZ
Str = String(lenData, Chr(0))
rt = RegQueryValueExStr(CHKey, ValueName, 0, rgtype, ByVal Str, lenData)
ReadRegValue = Left(Str, lenData - 1)
Caso REG_EXPAND_SZ
Str = String(lenData, Chr(0) )
rt = RegQueryValueExStr(CHKey, ValueName, 0, rgtype, ByVal Str, lenData)
ReadRegValue = ExpandEnvStr(Left(Str, lenData - 1))
Caso REG_DWORD, REG_DWORD_LITTLE_ENDIAN
rt = RegQueryValueExLong(CHKey, ValueName, 0, rgtype, ByVal dw, lenData)
ReadRegValue = CLng(dw)
Caso REG_DWORD_BIG_ENDIAN
rt = RegQueryValueExLong(CHKey, ValueName, 0, rgtype, ByVal dw, lenData)
ReadRegValue = SwapEndian(dw)
Caso REG_BINARY
ReDim bin(lenData)
rt = RegQueryValueExByte(CHKey, ValueName, 0&, rgtype, bin(0), lenData)
ReadRegValue = bin
Selección final
Función final
Función pública WriteRegValue (Nombre de valor opcional como cadena, Valor v opcional, Tipo de valor opcional como RegValueTypeConstants = REG_SZ) Siempre
CheckRegErr
Dim ordType As Long, c As Long, e As Long
Seleccione Case ValueType
>
Caso REG_BINARY
Si (varType(vValue) = vbArray + vbByte) Entonces
Dim ab() As Byte
ab = vValue
ordType = REG_BINARY
c = UBound(ab) - LBound(ab) - 1
e = RegSetValueExByte(CHKey, ValueName, 0&, ordType, ab(0 ), c)
Else
Err.Raise 26001
Finalizar si
Caso REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
Si (varType(vValue) = vbInteger) O (varType(vValue) = vbLong) Entonces
Atenúe i mientras
i = vValue
ordType = REG_DWORD
e = RegSetValueExLong(CHKey, ValueName, 0&, ordType, i, 4)
Fin si
Caso REG_SZ, REG_EXPAND_SZ
Dim s As String, iPos As Long
s = vValue
ordType = REG_SZ
' Supongamos que cualquier cosa con dos porcentajes no adyacentes es una cadena expandida
iPos = InStr(s, "%")
Si iPos Entonces
Si InStr(iPos + 2, s, "%") Entonces ordType = REG_EXPAND_SZ
Fin si
c = Len(s) + 1
e = RegSetValueExStr(CHKey, ValueName, 0&, ordType, s, c)
' El usuario debe convertir a un tipo compatible antes de llamar
Caso Else
e = ERROR_INVALID_DATA
Fin S
elegir
Finalizar función