How do I write hex values to the registry? - vb6

Question

I would like to write this to the registry:
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout]
"Scancode Map"=hex:
00,00,00,00,00,00,00,00,
04,00,00,00,3A,00,00,00,
00,00,3A,00,00,00,45,00,
00,00,00,00,00,00,00,00
"Scancode Map" is of type Binary.
I am using the following aged module to write to the registry, and I have never used the REG_BINARY option yet.
I would therefore like to ask how I could write these hex values to the registry using my aged module (which I got from the internet many years ago).
The following fails with Type Mismatch error:
ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, CByte(SubKeyValue), 4)
This is what I tried to pass:
WriteRegKey REG_BINARY, HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Keyboard Layout", "Scancode Map", "00,00,00,00,00,00,00,00,04,00,00,00,3A,00,00,00,00,00,3A,00,00,00,45,00,00,00,00,00,00,00,00,00"
When I try to write it as a string...
ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, ByVal SubKeyValue, Len(SubKeyValue))
... then it writes garbage to the registry.
Thank you!
'=========================================================================================
' modRegistry
' registry functions and routines
'=========================================================================================
' Adapted and Modified By: Marc Cramer
' Published Date: 04/18/2001
' Copyright Datr: Marc Cramer ?04/18/2001
' WebSite: www.mkccomputers.com
'=========================================================================================
' Based On: API description and examples from Windows API Guide
' WebSite: Windows API Guide # www.vbapi.com
' Based On: API description and examples from The AllAPI Network
' WebSite: The AllAPI Network # www.allapi.net
'=========================================================================================
Option Explicit
'=========================================================================================
' Enums/Constants used for Registry Access
'=========================================================================================
Public Enum KeyRoot
[HKEY_CLASSES_ROOT] = &H80000000 'stores OLE class information and file associations
[HKEY_CURRENT_CONFIG] = &H80000005 'stores computer configuration information
[HKEY_CURRENT_USER] = &H80000001 'stores program information for the current user.
[HKEY_LOCAL_MACHINE] = &H80000002 'stores program information for all users
[HKEY_USERS] = &H80000003 'has all the information for any user (not just the one provided by HKEY_CURRENT_USER)
End Enum
Public Enum KeyType
[REG_BINARY] = 3 'A non-text sequence of bytes
[REG_DWORD] = 4 'A 32-bit integer...visual basic data type of Long
[REG_SZ] = 1 'A string terminated by a null character
End Enum
Private Const KEY_ALL_ACCESS = &HF003F 'Permission for all types of access.
Private Const KEY_ENUMERATE_SUB_KEYS = &H8 'Permission to enumerate subkeys.
Private Const KEY_READ = &H20019 'Permission for general read access.
Private Const KEY_WRITE = &H20006 'Permission for general write access.
Private Const KEY_QUERY_VALUE = &H1 'Permission to query subkey data.
' used for import/export registry key
Private Const REG_FORCE_RESTORE As Long = 8& 'Permission to overwrite a registry key
Private Const TOKEN_QUERY As Long = &H8&
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const SE_RESTORE_NAME = "SeRestorePrivilege" 'Important for what we're trying to accomplish
Private Const SE_BACKUP_NAME = "SeBackupPrivilege"
'=========================================================================================
' Type used for Registry
'=========================================================================================
' used for writing registry keys
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
' used for enumerating registrykeys
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
' used for import/export registry key
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges As LUID_AND_ATTRIBUTES
End Type
'=========================================================================================
' API Function Declarations used for Registry
'=========================================================================================
Private Declare Function 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
Private Declare Function 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
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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As Any) As Long
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue 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
' used for export/import registry keys
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long 'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long 'Returns a valid LUID which is important when making security changes in NT.
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'=========================================================================================
' Routines used to Access Registry
'=========================================================================================
Public Function ExportRegKey(KeyRoot As KeyRoot, KeyPath As String, FileName As String) As Boolean
' routine to export registry keys
On Error Resume Next
Dim hKey As Long
Dim ReturnValue As Long
' check to see if allowed to do this
If EnablePrivilege(SE_BACKUP_NAME) = False Then
ExportRegKey = False
Exit Function
End If
' open the registry key
ReturnValue = RegOpenKeyEx(KeyRoot, KeyPath, 0&, KEY_ALL_ACCESS, hKey)
If ReturnValue <> 0 Then
' error encountered
ExportRegKey = False
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
' check for a copy of the export and delete old one if applicable
If Dir(FileName) <> "" Then Kill FileName
' export the registry key
ReturnValue = RegSaveKey(hKey, FileName, ByVal 0&)
If ReturnValue = 0 Then
' no error encountered
ExportRegKey = True
Else
' error encountered
ExportRegKey = False
End If
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'ExportRegKey(KeyRoot As KeyRoot, KeyPath As String, FileName As String) As Boolean
'=========================================================================================
Public Function ImportRegKey(KeyRoot As KeyRoot, KeyPath As String, FileName As String) As Boolean
' routine to import registry keys
' will overwrite current settings, but will not create keys
On Error Resume Next
Dim hKey As Long
Dim ReturnValue As Long
' check to see if allowed to do this
If EnablePrivilege(SE_RESTORE_NAME) = False Then
ImportRegKey = False
Exit Function
End If
' open the registry key
ReturnValue = RegOpenKeyEx(KeyRoot, KeyPath, 0&, KEY_ALL_ACCESS, hKey)
If ReturnValue <> 0 Then
' error encountered
ImportRegKey = False
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
' import the registry key
ReturnValue = RegRestoreKey(hKey, FileName, REG_FORCE_RESTORE)
If ReturnValue = 0 Then
' no error encountered
ImportRegKey = True
Else
' error encountered
ImportRegKey = False
End If
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'ImportRegKey(KeyRoot As KeyRoot, KeyPath As String, FileName As String) As Boolean
'=========================================================================================
Public Function ReadRegKey(KeyRoot As KeyRoot, KeyPath As String, SubKey As String, Optional NoKeyFoundValue As String = "") As String
' routine to read entry from registry
On Error Resume Next
Dim hKey As Long ' receives a handle to the opened registry key
Dim ReturnValue As Long ' return value
' open the registry key
ReturnValue = RegOpenKeyEx(KeyRoot, KeyPath, 0, KEY_READ, hKey)
If ReturnValue <> 0 Then
' key doesn't exist so return default value
ReadRegKey = NoKeyFoundValue
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
' get the keys value
ReadRegKey = GetSubKeyValue(hKey, SubKey)
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'ReadRegKey(KeyRoot As KeyRoot, KeyPath As String, SubKey As String, Optional NoKeyFoundValue As String = "") As String
'=========================================================================================
Public Function WriteRegKey(KeyType As KeyType, KeyRoot As KeyRoot, KeyPath As String, SubKey As String, SubKeyValue As String) As Boolean
' routine to write entry to registry
On Error Resume Next
Dim hKey As Long ' receives handle to the newly created or opened registry key
Dim SecurityAttribute As SECURITY_ATTRIBUTES ' security settings of the key
Dim NewKey As Long ' receives 1 if new key was created or 2 if an existing key was opened
Dim ReturnValue As Long ' return value
' Set the name of the new key and the default security settings
SecurityAttribute.nLength = Len(SecurityAttribute) ' size of the structure
SecurityAttribute.lpSecurityDescriptor = 0 ' default security level
SecurityAttribute.bInheritHandle = True ' the default value for this setting
' create or open the registry key
ReturnValue = RegCreateKeyEx(KeyRoot, KeyPath, 0, "", 0, KEY_WRITE, SecurityAttribute, hKey, NewKey)
If ReturnValue <> 0 Then
' error encountered
WriteRegKey = False
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
' determine type of key and write it to the registry
Select Case KeyType
Case REG_SZ
ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, ByVal SubKeyValue, Len(SubKeyValue))
Case REG_DWORD
ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, CLng(SubKeyValue), 4)
Case REG_BINARY
ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, CByte(SubKeyValue), 4)
End Select
If ReturnValue = 0 Then
' no error encountered
WriteRegKey = True
Else
' error encountered
WriteRegKey = False
End If
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'WriteRegKey(KeyType As KeyType, KeyRoot As KeyRoot, KeyPath As String, SubKey As String, SubKeyValue As String) As Boolean
'=========================================================================================
Public Function EnumerateRegKeys(KeyRoot As KeyRoot, KeyPath As String) As String
' routine to enumerate all subkeys under a registry key
On Error Resume Next
Dim hKey As Long ' receives a handle to the opened registry key
Dim ReturnValue As Long ' return value
Dim Counter As Long
Dim MyBuffer As String
Dim MyBufferSize As Long
Dim ClassNameBuffer As String
Dim ClassNameBufferSize As Long
Dim LastWrite As FILETIME
' open the registry key
ReturnValue = RegOpenKeyEx(KeyRoot, KeyPath, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
If ReturnValue <> 0 Then
' key doesn't exist so return default value
EnumerateRegKeys = ""
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
Counter = 0
' loop until no more registry keys
Do Until ReturnValue <> 0
MyBuffer = Space(255)
ClassNameBuffer = Space(255)
MyBufferSize = 255
ClassNameBufferSize = 255
ReturnValue = RegEnumKeyEx(hKey, Counter, MyBuffer, MyBufferSize, ByVal 0, ClassNameBuffer, ClassNameBufferSize, LastWrite)
If ReturnValue = 0 Then
MyBuffer = Left$(MyBuffer, MyBufferSize)
ClassNameBuffer = Left$(ClassNameBuffer, ClassNameBufferSize)
EnumerateRegKeys = EnumerateRegKeys & MyBuffer & ","
End If
Counter = Counter + 1
Loop
' trim off the last delimiter
If EnumerateRegKeys <> "" Then EnumerateRegKeys = Left$(EnumerateRegKeys, Len(EnumerateRegKeys) - 1)
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'EnumerateRegKeys(KeyRoot As KeyRoot, KeyPath As String) As String
'=========================================================================================
Public Function EnumerateRegKeyValues(KeyRoot As KeyRoot, KeyPath As String) As String
' routine to enumerate all the values under a key in the registry
On Error Resume Next
Dim hKey As Long ' receives a handle to the opened registry key
Dim ReturnValue As Long ' return value
Dim Counter As Long
Dim MyBuffer As String
Dim MyBufferSize As Long
Dim KeyType As KeyType
' open the registry key to enumerate the values of.
ReturnValue = RegOpenKeyEx(KeyRoot, KeyPath, 0, KEY_QUERY_VALUE, hKey)
' check to see if an error occured.
If ReturnValue <> 0 Then
EnumerateRegKeyValues = ""
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
Counter = 0
' loop until no more registry keys value
Do Until ReturnValue <> 0
MyBuffer = Space(255)
MyBufferSize = 255
ReturnValue = RegEnumValue(hKey, Counter, MyBuffer, MyBufferSize, 0, KeyType, ByVal 0&, ByVal 0&) 'ByteData(0), ByteDataSize)
If ReturnValue = 0 Then
MyBuffer = Left$(MyBuffer, MyBufferSize)
EnumerateRegKeyValues = EnumerateRegKeyValues & MyBuffer & "*"
EnumerateRegKeyValues = EnumerateRegKeyValues & GetSubKeyValue(hKey, MyBuffer) & ","
End If
Counter = Counter + 1
Loop
' trim off the last delimiter
If EnumerateRegKeyValues <> "" Then EnumerateRegKeyValues = Left$(EnumerateRegKeyValues, Len(EnumerateRegKeyValues) - 1)
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'EnumerateRegKeyValues(KeyRoot As KeyRoot, KeyPath As String) As String
'=========================================================================================
Public Function DeleteRegKey(KeyRoot As KeyRoot, KeyPath As String, SubKey As String) As Boolean
' routine to delete a registry key
' under Win NT/2000 all subkeys must be deleted first
' under Win 9x all subkeys are deleted
On Error Resume Next
Dim ReturnValue As Long ' return value
' Attempt to delete the desired registry key.
ReturnValue = RegDeleteKey(KeyRoot, KeyPath & "\" & SubKey)
If ReturnValue = 0 Then
' no error encountered
DeleteRegKey = True
Else
' error encountered
DeleteRegKey = False
End If
End Function 'DeleteRegKey(KeyRoot As KeyRoot, KeyPath As String, SubKey As String) As Boolean
'=========================================================================================
Public Function DeleteRegKeyValue(KeyRoot As KeyRoot, KeyPath As String, Optional SubKey As String = "") As Boolean
' routine to delete a value from a key (but not the key) in the registry
On Error Resume Next
Dim hKey As Long ' handle to the open registry key
Dim ReturnValue As Long ' return value
' First, open up the registry key which holds the value to delete.
ReturnValue = RegOpenKeyEx(KeyRoot, KeyPath, 0, KEY_ALL_ACCESS, hKey)
If ReturnValue <> 0 Then
' error encountered
DeleteRegKeyValue = False
ReturnValue = RegCloseKey(hKey)
Exit Function
End If
' check to see if we are deleting a subkey or primary key
If SubKey = "" Then SubKey = KeyPath
' successfully opened registry key so delete the desired value from the key.
ReturnValue = RegDeleteValue(hKey, SubKey)
If ReturnValue = 0 Then
' no error encountered
DeleteRegKeyValue = True
Else
' error encountered
DeleteRegKeyValue = False
End If
' close the registry key
ReturnValue = RegCloseKey(hKey)
End Function 'DeleteRegKeyValue(KeyRoot As KeyRoot, KeyPath As String, Optional SubKey As String = "") As Boolean
'=========================================================================================
Private Function GetSubKeyValue(ByVal hKey As Long, ByVal SubKey As String) As String
' routine to get the registry key value and convert to a string
On Error Resume Next
Dim ReturnValue As Long
Dim KeyType As KeyType
Dim MyBuffer As String
Dim MyBufferSize As Long
'get registry key information
ReturnValue = RegQueryValueEx(hKey, SubKey, 0, KeyType, ByVal 0, MyBufferSize)
If ReturnValue = 0 Then ' no error encountered
' determine what the KeyType is
Select Case KeyType
Case REG_SZ
' create a buffer
MyBuffer = String(MyBufferSize, Chr$(0))
' retrieve the key's content
ReturnValue = RegQueryValueEx(hKey, SubKey, 0, 0, ByVal MyBuffer, MyBufferSize)
If ReturnValue = 0 Then
' remove the unnecessary chr$(0)'s
GetSubKeyValue = Left$(MyBuffer, InStr(1, MyBuffer, Chr$(0)) - 1)
End If
Case Else 'REG_DWORD or REG_BINARY
Dim MyNewBuffer As Long
' retrieve the key's value
ReturnValue = RegQueryValueEx(hKey, SubKey, 0, 0, MyNewBuffer, MyBufferSize)
If ReturnValue = 0 Then ' no error encountered
GetSubKeyValue = MyNewBuffer
End If
End Select
End If
End Function 'GetSubKeyValue(ByVal hKey As Long, ByVal SubKey As String) As String
'=========================================================================================
Private Function EnablePrivilege(seName As String) As Boolean
' routine to enable inport/export of registry settings
On Error Resume Next
Dim p_lngRtn As Long
Dim p_lngToken As Long
Dim p_lngBufferLen As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
' open the current process token
p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken)
If p_lngRtn = 0 Then
' error encountered
EnablePrivilege = False
Exit Function
End If
If Err.LastDllError <> 0 Then
' error encountered
EnablePrivilege = False
Exit Function
End If
' look up the privileges LUID
p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)
If p_lngRtn = 0 Then
' error encountered
EnablePrivilege = False
Exit Function
End If
' adjust the program's security privilege.
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.Privileges.pLuid = p_typLUID
' try to adjust privileges and return success or failure
EnablePrivilege = (AdjustTokenPrivileges(p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0)
End Function 'EnablePrivilege(seName As String) As Boolean
'=========================================================================================
I have tried the StrPtr approach, and here is what it does for me:
SubKey = "00,00,00,00,00,00,00,00,04,00,00,00,3A,00,00,00,00,00,3A,00,00,00,45,00,00,00,00,00,00,00,00,00"
ReturnValue = RegSetValueEx(hKey, SubKey, 0, REG_BINARY, StrPtr(SubKeyValue), Len(SubKeyValue))

Answer 1

You need to put all those hex values in a byte array and pass the first element of the array (byteArray(0)) as a parameter to the RegSetValueEx function. The last parameter is the length of the array: ubound(byteArray)-lbound(byteArray)+1
Using your existing code you can also write it as:
ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, StrPtr(SubKeyValue), Len(SubKeyValue))
That is assuming the "SubKeyValue" string actually contains those hex bytes that you want written.