Autor
.Código:
Option Explicit
Private Declare Function OSRegOpenKeyEx 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 OSRegCreateKeyEx 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function OSRegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Private Declare Function OSRegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function OSRegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Private Declare Function OSRegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function OSRegFlushKey Lib "advapi32.dll" Alias "RegFlushKey" (ByVal hKey As Long) As Long
Private Declare Function OSRegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function OSRegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
Private Declare Function OSRegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function OSRegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function OSRegEnumValue 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 Byte, lpcbData As Long) As Long
Private Declare Function OSRegQueryValueEx 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
Private Declare Function OSRegSetValueEx 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
Private Declare Function OSRegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'Tipos de datos del registro
'
Const REG_NONE = 0 'No definido
Const REG_SZ = 1 'Cadena de texto
Const REG_EXPAND_SZ = 2 'Cadena que contiene una referencia a una variable de entorno (por ej. %windir%)
Const REG_BINARY = 3 'Datos binarios en cualquier formato
Const REG_DWORD = 4 'Número de 32 bits
Const REG_DWORD_LITTLE_ENDIAN = 4 'Igual a REG_DWORD
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6 'Un vínculo Unicode símbolico
Const REG_MULTI_SZ = 7 'Una matriz de cadenas terminadas en dos caracteres nulos
Const REG_RESOURCE_LIST = 8 'Lista de recursos de un controlador de dispositivo
Const READ_CONTROL = &H20000 'El derecho para leer la información en el descriptor de seguridad del objeto, no incluyendo la información en SACL.
Const SYNCHRONIZE = &H100000
'Derechos normales de acceso
'
Const STANDARD_RIGHTS_ALL = &H1F0000 'Lectura y escritura
Const STANDARD_RIGHTS_READ = (READ_CONTROL) 'Lectura
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) 'Escritura
'Argumentos para RegOpenKey
'
Const KEY_QUERY_VALUE = &H1 'Permiso para consultar los datos de una subclave
Const KEY_SET_VALUE = &H2 'Permiso para establecer los datos de una subclave
Const KEY_CREATE_SUB_KEY = &H4 'Permiso para crear subclaves
Const KEY_ENUMERATE_SUB_KEYS = &H8 'Permiso para enumerar subclaves
Const KEY_NOTIFY = &H10 'Permiso para cambiar notificación
Const KEY_CREATE_LINK = &H20 'Permiso para crear un vínculo simbólico
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
'Valores devueltos por lpdwDisposition de RegCreateKey
'
Const REG_CREATED_NEW_KEY = &H1 'Se creó una nueva clave
Const REG_OPENED_EXISTING_KEY = &H2 'Se abrió una clave existente
'Valores para dwNotifyFilter de RegNotifyChangeKeyValue
'
Const REG_NOTIFY_CHANGE_NAME = &H1 'Si se agrega o elimina una clave
Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2 'Cambiar atributos de la clave
Const REG_NOTIFY_CHANGE_LAST_SET = &H4 'Modificar, agregar o eliminar un valor de la clave
Const REG_NOTIFY_CHANGE_SECURITY = &H8 'Cambiar el descriptor de seguridad de la clave (SECURITY_DESCRIPTOR)
'Argumentos para dwOptions de RegCreateKey
'
Const REG_OPTION_NON_VOLATILE = 0 '(Predeterminado) Crea una clave normalmente
Const REG_OPTION_VOLATILE = 1 'Borra la clave al reiniciar el sistema
Const REG_OPTION_CREATE_LINK = 2 'Crea un vínculo virtual
Const REG_OPTION_BACKUP_RESTORE = 4 'Para Windows NT
Const REG_OPTION_RESERVED = 0 'Reservado
Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
'Para el argumento dwFlags de RegRestoreKey
'
Const REG_WHOLE_HIVE_VOLATILE = &H1 'Borra la clave al reiniciar el sistema
'Claves del registro
'
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_DYN_DATA = &H80000006
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_PERFORMANCE_DATA = &H80000004 'Sólo para NT
Const HKEY_USERS = &H80000003
Const ERROR_SUCCESS = 0&
Const ERROR_NO_MORE_ITEMS = 259& 'No hay más elementos
Const MODULE_DESC$ = "Registry Module"
Enum RegKeyConstants
RegClassesRoot = HKEY_CLASSES_ROOT
RegCurrentConfig = HKEY_CURRENT_CONFIG
RegCurrentUser = HKEY_CURRENT_USER
RegDynData = HKEY_DYN_DATA
RegLocalMachine = HKEY_LOCAL_MACHINE
RegPerformanceData = HKEY_PERFORMANCE_DATA
RegUsers = HKEY_USERS
End Enum
Enum RegAccessType
regqueryvalue = KEY_QUERY_VALUE
RegSetValue = KEY_SET_VALUE
RegCreateSubKey = KEY_CREATE_SUB_KEY
RegEnumerateSubKeys = KEY_ENUMERATE_SUB_KEYS
RegNotify = KEY_NOTIFY
RegCreateLink = KEY_CREATE_LINK
RegAllAccess = KEY_ALL_ACCESS
RegRead = KEY_READ
RegWrite = KEY_WRITE
RegExecute = KEY_EXECUTE
End Enum
Enum RegValueTypeConstants
RegString = REG_SZ
RegExpandString = REG_EXPAND_SZ
RegMultiString = REG_MULTI_SZ
RegBinary = REG_BINARY
RegDWORD = REG_DWORD
RegDWORDLittleEndian = REG_DWORD_LITTLE_ENDIAN
RegDWORDBigEndian = REG_DWORD_BIG_ENDIAN
RegLink = REG_LINK
RegUnknown = REG_NONE
RegResourceList = REG_RESOURCE_LIST
End Enum
Enum RegCreateOptionsConstants
RegVolatile = REG_OPTION_VOLATILE
RegNonVolatile = REG_OPTION_NON_VOLATILE
RegOptionBackupRestore = REG_OPTION_BACKUP_RESTORE
End Enum
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type RegValue
sName As String
cType As RegValueTypeConstants
vData As Variant
lData As Long
End Type
Type RegKey
lLongKey As RegKeyConstants
sStringKey As String
sPath As String
sName As String
lNameLen As Long
lHandle As Long
lSubKeys As Long
lValues As Long
tValues() As RegValue
sClass As String
End Type
Function RegOpenKey(Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional DesiredAccess As RegAccessType = RegAllAccess) As RegKey
Dim iPos%, r&
With RegOpenKey
r = OSRegOpenKeyEx(CLng(Key), SubKey, 0&, CLng(DesiredAccess), .lHandle)
If r = ERROR_SUCCESS Then
If Right(SubKey, 1) = "\" Then SubKey = Left(SubKey, Len(SubKey) - 1)
iPos = InStrRev("\", SubKey)
.sName = Mid(SubKey, iPos + 1)
.lNameLen = LenB(.sName)
.lLongKey = Key
.sStringKey = GetKeyString(.lLongKey)
.sPath = Left(SubKey, iPos)
End If
End With
End Function
Function RegCreateKey(Key As RegKeyConstants, SubKey As String, Optional Options As RegCreateOptionsConstants = RegNonVolatile, Optional DesiredAccess As RegAccessType = RegAllAccess, Optional Class As String) As RegKey
Dim sa As SECURITY_ATTRIBUTES, r&
Dim iPos%
With RegCreateKey
r = OSRegCreateKeyEx(CLng(Key), SubKey, 0&, Class, CLng(Options), _
CLng(DesiredAccess), sa, .lHandle, 0&)
If r = ERROR_SUCCESS Then
If Not Right(SubKey, 1) Like "\" Then SubKey = SubKey & "\"
iPos = InStrRev("\", SubKey)
.sName = Mid(SubKey, iPos + 1)
.lNameLen = LenB(.sName)
.lLongKey = Key
.sStringKey = GetKeyString(.lLongKey)
.sPath = Left(SubKey, iPos)
End If
End With
End Function
Function RegConnectRegistry(MachineName As String, Optional Key As RegKeyConstants = RegLocalMachine) As RegKey
Dim r&
With RegConnectRegistry
r = OSRegConnectRegistry(MachineName, CLng(Key), .lHandle)
If r = ERROR_SUCCESS Then
.sName = GetKeyString(Key)
.lNameLen = LenB(.sName)
.lLongKey = Key
.sStringKey = GetKeyString(.lLongKey)
End If
End With
End Function
Function RegCloseKey(hKey As Long) As Boolean
RegCloseKey = (OSRegCloseKey(hKey) = ERROR_SUCCESS)
End Function
Function RegDeleteKey(Key As RegKeyConstants, SubKey As String) As Boolean
RegDeleteKey = (OSRegDeleteKey(CLng(Key), SubKey) = ERROR_SUCCESS)
End Function
Function RegEnumKeyNames(TargetArray() As String, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional MaxKeysToEnum As Long = -1) As Long
On Error GoTo CloseKey
Dim iCount%, iArrayType%
Dim hKey&, ft As FILETIME
Dim r&, sName$, lName&
hKey = RegOpenKey(Key, SubKey, RegEnumerateSubKeys).lHandle
If hKey <> ERROR_SUCCESS Then
Erase TargetArray
Do
lName = 256: sName = String(lName, 0)
r = OSRegEnumKeyEx(hKey, iCount, sName, lName, 0&, ByVal "", 0&, ft)
If r <> ERROR_NO_MORE_ITEMS Then
ReDim Preserve TargetArray(iCount) As String
TargetArray(iCount) = Left(sName, lName)
Else
GoTo CloseKey
End If
Step:
iCount = iCount + 1
If MaxKeysToEnum > -1 And iCount = MaxKeysToEnum Then GoTo CloseKey
Loop
CloseKey:
Call RegCloseKey(hKey)
RegEnumKeyNames = iCount
End If
End Function
Function RegEnumKeys(TargetArray() As RegKey, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional bEnumValues As Boolean = False, Optional MaxKeysToEnum As Long = -1) As Long
On Error GoTo CloseKey
Dim iCount%, iArrayType%
Dim hKey&, ft As FILETIME
Dim r&, sName$, lName&
Dim sClass$, lClass&
hKey = RegOpenKey(Key, SubKey, RegEnumerateSubKeys).lHandle
If hKey <> ERROR_SUCCESS Then
Erase TargetArray
Do
lName = 256: sName = String(lName, 0)
lClass = 256: sClass = String(lName, 0)
r = OSRegEnumKeyEx(hKey, iCount, sName, lName, 0&, sClass, lClass, ft)
If bEnumValues Then
'Enumerar valores
End If
If r <> ERROR_NO_MORE_ITEMS Then
ReDim Preserve TargetArray(iCount) As RegKey
With TargetArray(iCount)
.sName = Left(sName, lName)
.lNameLen = LenB(.sName)
.lLongKey = Key
.sStringKey = GetKeyString(.lLongKey)
.sPath = SubKey
.lValues = RegEnumValues(.tValues, hKey)
End With
Else
GoTo CloseKey
End If
Step:
iCount = iCount + 1
If MaxKeysToEnum > -1 And iCount = MaxKeysToEnum Then GoTo CloseKey
Loop
CloseKey:
Call RegCloseKey(hKey)
RegEnumKeys = iCount - 1
End If
End Function
Function RegQueryInfoKey(Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional QueryValues As Boolean = False, Optional OpenKey As Boolean = False) As RegKey
Dim hKey&, ft As FILETIME
Dim lClass&, r&
Dim iPos%
With RegQueryInfoKey
hKey = RegOpenKey(Key, SubKey, RegRead).lHandle
If hKey <> ERROR_SUCCESS Then
lClass = 256: .sClass = String(lClass, 0)
r = OSRegQueryInfoKey(hKey, .sClass, lClass, 0&, .lSubKeys, 0&, 0&, .lValues, 0&, 0&, 0&, ft)
If r = ERROR_SUCCESS Then
iPos = InStrRev(SubKey, "\")
.sClass = Left(.sClass, lClass)
.sName = Mid(SubKey, iPos + 1)
.lNameLen = Len(.sName)
.sPath = Left(SubKey, iPos)
.lLongKey = Key
.sStringKey = GetKeyString(.lLongKey)
If Not OpenKey Then Call RegCloseKey(hKey) Else .lHandle = hKey
If QueryValues Then
r = RegEnumValues(.tValues, Key, SubKey)
End If
End If
End If
End With
End Function
Function RegFlushKey(hKey As Long) As Boolean
RegFlushKey = (OSRegFlushKey(hKey) = ERROR_SUCCESS)
End Function
Function RegEnumValueNames(TargetArray() As String, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String) As Long
On Error GoTo CloseKey
Dim hKey&, r&
Dim sName$, lName&
Dim lCount&
Dim btData As Byte, lData&
Dim lType&
hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle
If hKey <> ERROR_SUCCESS Then
Erase TargetArray
Do
lName = 256: sName = String(lName, 0)
lData = 2000
r = OSRegEnumValue(hKey, lCount&, sName, lName, 0&, 0&, ByVal btData, lData)
If r = ERROR_SUCCESS Then
ReDim Preserve TargetArray(lCount) As String
TargetArray(lCount) = Left(sName, lName)
Else: GoTo CloseKey
End If
lCount = lCount + 1
Loop
CloseKey:
Call RegCloseKey(hKey)
RegEnumValueNames = lCount - 1
End If
End Function
Function RegEnumValues(TargetArray() As RegValue, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String) As Long
On Error GoTo CloseKey
Dim hKey&, r&
Dim sName$, lName&
Dim lCount&
Dim btData As Byte, lData&
Dim lType&
hKey = RegOpenKey(Key, SubKey, KEY_QUERY_VALUE).lHandle
If hKey <> ERROR_SUCCESS Then
Erase TargetArray
Do
lName = 256: sName = String(lName, 0)
lData = 2000
r = OSRegEnumValue(hKey, lCount&, sName, lName, 0&, lType, ByVal btData, lData)
If r = ERROR_SUCCESS Then
ReDim Preserve TargetArray(lCount) As RegValue
TargetArray(lCount) = RegGetValue(hKey, , Left(sName, lName))
Else: GoTo CloseKey
End If
lCount = lCount + 1
Loop
CloseKey:
Call RegCloseKey(hKey)
RegEnumValues = lCount - 1
End If
End Function
Function RegGetValueData(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As Variant
Dim hKey&, r&
Dim sData$, lDataLen&
Dim lData&, ValType As RegValueTypeConstants
hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle
ValType = RegString
If hKey <> ERROR_SUCCESS Then
Select Case ValType
Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
sData = String(2000, 0)
lDataLen = LenB(sData)
r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
ByVal sData, lDataLen)
If ValType = RegDWORD Or ValType = RegDWORDBigEndian Or ValType = RegDWORDLittleEndian Then GoTo LongType
RegGetValueData = Left(sData, lDataLen - 1)
Case Else
LongType:
r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
lData, lDataLen)
RegGetValueData = lData
End Select
Call RegCloseKey(hKey)
End If
End Function
Function RegGetValue(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As RegValue
Dim hKey&, r&
Dim sData$, lDataLen&
Dim lData&, ValType As RegValueTypeConstants
hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle
ValType = RegString
If hKey <> ERROR_SUCCESS Then
With RegGetValue
Select Case ValType
Case RegLink, RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
sData = String(2000, 0)
lDataLen = LenB(sData)
r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
ByVal sData, lDataLen)
If ValType = RegDWORD Or ValType = RegDWORDBigEndian Or ValType = RegDWORDLittleEndian Then GoTo LongType
If r = ERROR_SUCCESS Then
.vData = Left(sData, lDataLen)
.lData = lDataLen
.cType = ValType
.sName = ValueName
End If
Case Else
LongType:
r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
lData, lDataLen)
If r = ERROR_SUCCESS Then
.vData = lData
.lData = lDataLen
.cType = ValType
.sName = ValueName
End If
End Select
Call RegCloseKey(hKey)
End With
End If
End Function
Function RegDeleteValue(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As Boolean
Dim hKey&
hKey = RegOpenKey(Key, SubKey, RegSetValue).lHandle
RegDeleteValue = (OSRegDeleteValue(hKey, ValueName) = ERROR_SUCCESS)
Call RegCloseKey(hKey)
End Function
Function RegSetValues(Key As RegKeyConstants, SubKey As String, ValueName As Variant, Data As Variant, Optional ValueType As RegValueTypeConstants = RegString) As Integer
Dim hKey&, r&
Dim i%, iScsCount%
hKey = RegOpenKey(Key, SubKey, RegSetValue).lHandle
If hKey <> ERROR_SUCCESS Then
If IsArray(ValueName) And IsArray(Data) Then
'Si son dos matrices
If (UBound(ValueName) - LBound(ValueName)) <> (UBound(Data) - LBound(Data)) Then
'Si no tienen las mismas dimensiones se produce un error
Call Err.Raise(45, MODULE_DESC, "Las matrices no tienen la misma dimensión")
Else
For i = LBound(ValueName) To UBound(ValueName)
'Identifica el tipo de valor que se va a establecer
Select Case ValueType
Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
CLng(ValueType), ByVal CStr(Data(i)), LenB(Data(i)))
Case Else
r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
CLng(ValueType), CLng(Data(i)), 4)
End Select
'Si no hay ningún error aumenta el contador de valores
'que se pudieron establecer
If r = ERROR_SUCCESS Then iScsCount = iScsCount + 1
Next
'Devuelve el la cantidad de valores que se establecieron
RegSetValues = iScsCount
End If
ElseIf IsArray(ValueName) Then
'Si los nombres de valores están en una matriz
For i = LBound(ValueName) To UBound(ValueName)
'Establece todos los valores pero con los mismos datos
Select Case ValueType
Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
CLng(ValueType), ByVal CStr(Data), LenB(Data))
Case Else
r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
CLng(ValueType), CLng(Data), 4)
End Select
If r = ERROR_SUCCESS Then iScsCount = iScsCount + 1
Next
RegSetValues = iScsCount
Else
Select Case ValueType
Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown, RegLink
r = OSRegSetValueEx(hKey, ValueName, 0&, _
CLng(ValueType), ByVal CStr(Data), LenB(Data))
Case Else
r = OSRegSetValueEx(hKey, ValueName, 0&, _
CLng(ValueType), CLng(Data), 4)
End Select
RegSetValues = True
End If
End If
Call RegCloseKey(hKey)
End Function
Function RegIsKey(Key As RegKeyConstants, Optional ByVal SubKey As String) As Boolean
Dim hKey&
hKey = RegOpenKey(Key, SubKey).lHandle
RegIsKey = (hKey <> 0)
Call RegCloseKey(hKey)
End Function
Function GetKeyString(hKey As Variant) As String
Select Case hKey
Case RegClassesRoot, "HKCR", "HKEY_CLASSES_ROOT": GetKeyString = "HKEY_CLASSES_ROOT"
Case RegCurrentConfig, "HKCC", "HKEY_CURRENT_CONFIG": GetKeyString = "HKEY_CURRENT_CONFIG"
Case RegCurrentUser, "HKCU", "HKEY_CURRENT_USER": GetKeyString = "HKEY_CURRENT_USER"
Case RegDynData, "HKDD", "HKEY_DYN_DATA": GetKeyString = "HKEY_DYN_DATA"
Case RegLocalMachine, "HKLM", "HKEY_LOCAL_MACHINE": GetKeyString = "HKEY_LOCAL_MACHINE"
Case RegPerformanceData, "HKPD", "HKEY_PERFORMANCE_DATA": GetKeyString = "HKEY_PERFORMANCE_DATA"
Case RegUsers, "HKU", "HKEY_USERS": GetKeyString = "HKEY_USERS"
End Select
End Function
Function GetKeyLong(hKey As Variant) As String
Select Case hKey
Case RegClassesRoot, "HKCR", "HKEY_CLASSES_ROOT": GetKeyLong = RegClassesRoot
Case RegCurrentConfig, "HKCC", "HKEY_CURRENT_CONFIG": GetKeyLong = RegCurrentConfig
Case RegCurrentUser, "HKCU", "HKEY_CURRENT_USER": GetKeyLong = RegCurrentUser
Case RegDynData, "HKDD", "HKEY_DYN_DATA": GetKeyLong = RegDynData
Case RegLocalMachine, "HKLM", "HKEY_LOCAL_MACHINE": GetKeyLong = RegLocalMachine
Case RegPerformanceData, "HKPD", "HKEY_PERFORMANCE_DATA": GetKeyLong = RegPerformanceData
Case RegUsers, "HKU", "HKEY_USERS": GetKeyLong = RegUsers
End Select
End Function
Cualquier cosa que no entiendan dirigirse a MSDN
.Saludos.
En línea
, cualquier problema personal por IM, y no voy a borrar estos post como hacen algunos moderadores, solo porque no me gusta o no les conviene.
