• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 339
  • Last Modified:

Set Registry Binary Value

Hello experts

How can i set an exact binary value to the windows registry?

For example, The binary i need to set is this "62 00 01 00 01 00"
If i comvert this binary value to text i get this result: "b...."
But if i set that value back to the registry, i get these: "62 2e 2e 2e"

How can i set this value?

Example: "62 00 01 00"

Thanks
0
Father-Of-Time
Asked:
Father-Of-Time
  • 21
  • 18
1 Solution
 
Ashish PatelCommented:
Use below as a class file code. This will allow you to read and write registry keys.

Option Explicit

'Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F

'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1

'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2

'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF

'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 '  dderror
Private Const ERROR_NO_MORE_ITEMS = 259


'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

'Registry Function Prototypes
Private Declare Function RegOpenKeyEx Lib "advapi32" 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 RegSetValueExStr Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Declare Function 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
Private Declare Function 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
Private Declare Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
   
Private Declare Function RegCreateKeyEx Lib "advapi32" 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 RegEnumKeyEx 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 RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
    ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    ByVal cbName As Long) 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, ByVal lpType As Long, _
   ByVal lpData As Long, ByVal lpcbData As Long) As Long
   
Private Declare Function 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
Private Declare Function RegEnumValueStr 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, _
   ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValueByte 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 RegQueryInfoKey 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 Any) As Long

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  (ByVal hKey As Long, ByVal lpSubKey As String) As Long

' Other declares:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long


Public Enum ERegistryClassConstants
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End Enum

Public Enum ERegistryValueTypes
'Predefined Value Types
    REG_NONE = (0)                         'No value type
    REG_SZ = (1)                           'Unicode nul terminated string
    REG_EXPAND_SZ = (2)                    'Unicode nul terminated string w/enviornment var
    REG_BINARY = (3)                       'Free form binary
    REG_DWORD = (4)                        '32-bit number
    REG_DWORD_LITTLE_ENDIAN = (4)          '32-bit number (same as REG_DWORD)
    REG_DWORD_BIG_ENDIAN = (5)             '32-bit number
    REG_LINK = (6)                         'Symbolic Link (unicode)
    REG_MULTI_SZ = (7)                     'Multiple Unicode strings
    REG_RESOURCE_LIST = (8)                'Resource list in the resource map
    REG_FULL_RESOURCE_DESCRIPTOR = (9)     'Resource list in the hardware description
    REG_RESOURCE_REQUIREMENTS_LIST = (10)
End Enum

Private m_hClassKey As Long
Private m_sSectionKey As String
Private m_sValueKey As String
Private m_vValue As Variant
Private m_sSetValue As String
Private m_vDefault As Variant
Private m_eValueType As ERegistryValueTypes

Public Property Get Value() As Variant
Dim vValue As Variant
Dim cData As Long, sData As String, ordType As Long, e As Long
Dim hKey As Long

    e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
    'ApiRaiseIf¬†e

    e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, 0&, cData)
    If e And e <> ERROR_MORE_DATA Then
        Value = m_vDefault
        Exit Property
    End If
   
    m_eValueType = ordType
    Select Case ordType
    Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
        Dim iData As Long
        e = RegQueryValueExLong(hKey, m_sValueKey, 0&, _
                               ordType, iData, cData)
        vValue = CLng(iData)
       
    Case REG_DWORD_BIG_ENDIAN  ' Unlikely, but you never know
        Dim dwData As Long
        e = RegQueryValueExLong(hKey, m_sValueKey, 0&, _
                               ordType, dwData, cData)
        vValue = SwapEndian(dwData)
       
    Case REG_SZ, REG_MULTI_SZ ' Same thing to Visual Basic
        sData = String$(cData - 1, 0)
        e = RegQueryValueExStr(hKey, m_sValueKey, 0&, _
                               ordType, sData, cData)
        vValue = sData
       
    Case REG_EXPAND_SZ
        sData = String$(cData - 1, 0)
        e = RegQueryValueExStr(hKey, m_sValueKey, 0&, _
                               ordType, sData, cData)
        vValue = ExpandEnvStr(sData)
       
    ' Catch REG_BINARY and anything else
    Case Else
        Dim abData() As Byte
        ReDim abData(cData)
        e = RegQueryValueExByte(hKey, m_sValueKey, 0&, _
                                ordType, abData(0), cData)
        vValue = abData
       
    End Select
    Value = vValue
   
End Property
Public Property Let Value( _
        ByVal vValue As Variant _
    )
Dim ordType As Long
Dim c As Long
Dim hKey As Long
Dim e As Long
Dim lCreate As Long
Dim tSA As SECURITY_ATTRIBUTES

    'Open or Create the key
    e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
                 KEY_ALL_ACCESS, tSA, hKey, lCreate)
   
    If e Then
        Err.Raise 26001, App.EXEName & ".RegistryAction", "Failed to set registry value Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey & "',Key: '" & m_sValueKey & "' to value: '" & m_vValue & "'"
    Else

        Select Case m_eValueType
        Case REG_BINARY
            If (VarType(vValue) = vbArray + vbByte) Then
                Dim ab() As Byte
                ab = vValue
                ordType = REG_BINARY
                c = UBound(ab) - LBound(ab) - 1
                e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), c)
            Else
                Err.Raise 26001
            End If
        Case REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
            If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
                Dim i As Long
                i = vValue
                ordType = REG_DWORD
                e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, i, 4)
            End If
        Case REG_SZ, REG_EXPAND_SZ
            Dim s As String, iPos As Long
            s = vValue
            ordType = REG_SZ
            ' Assume anything with two non-adjacent percents is expanded string
            iPos = InStr(s, "%")
            If iPos Then
                If InStr(iPos + 2, s, "%") Then ordType = REG_EXPAND_SZ
            End If
            c = Len(s) + 1
            e = RegSetValueExStr(hKey, m_sValueKey, 0&, ordType, s, c)
           
        ' User should convert to a compatible type before calling
        Case Else
            e = ERROR_INVALID_DATA
           
        End Select
       
        If Not e Then
            m_vValue = vValue
        Else
            Err.Raise vbObjectError + 1048 + 26001, App.EXEName & ".RegistryAction", "Failed to set registry value Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey & "',Key: '" & m_sValueKey & "' to value: '" & m_vValue & "'"
        End If
       
        'Close the key
        RegCloseKey hKey
   
    End If
   
End Property

Public Property Get ValueType() As ERegistryValueTypes
    ValueType = m_eValueType
End Property
Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
    m_eValueType = eValueType
End Property
Public Property Get ClassKey() As ERegistryClassConstants
    ClassKey = m_hClassKey
End Property
Public Property Let ClassKey( _
        ByVal eKey As ERegistryClassConstants _
    )
    m_hClassKey = eKey
End Property
Public Property Get SectionKey() As String
    SectionKey = m_sSectionKey
End Property
Public Property Let SectionKey( _
        ByVal sSectionKey As String _
    )
    m_sSectionKey = sSectionKey
End Property
Public Property Get ValueKey() As String
    ValueKey = m_sValueKey
End Property
Public Property Let ValueKey( _
        ByVal sValueKey As String _
    )
    m_sValueKey = sValueKey
End Property
Public Property Get Default() As Variant
    Default = m_vDefault
End Property
Public Property Let Default( _
        ByVal vDefault As Variant _
    )
    m_vDefault = vDefault
End Property
Private Function SwapEndian(ByVal dw As Long) As Long
    CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
    CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
    CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
    CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
End Function
Private Function ExpandEnvStr(sData As String) As String
    Dim c As Long, s As String
    ' Get the length
    s = "" ' Needed to get around Windows 95 limitation
    c = ExpandEnvironmentStrings(sData, s, c)
    ' Expand the string
    s = String$(c - 1, 0)
    c = ExpandEnvironmentStrings(sData, s, c)
    ExpandEnvStr = s
End Function
0
 
Ashish PatelCommented:
Helping function to Set registry value.

Function SetGetRegistryValue(SetOrGet As String, l_ValueKey As String, l_ValueType As Variant, Optional l_Value As Variant) As String
    Dim clsRegObj As New RegistryAction
   
    clsRegObj.ClassKey = HKEY_LOCAL_MACHINE
    clsRegObj.SectionKey = "Software\Subscription"
    clsRegObj.ValueKey = l_ValueKey
    clsRegObj.ValueType = l_ValueType
    If SetOrGet = "Set" Then
        clsRegObj.Value = l_Value
    Else
        SetGetRegistryValue = clsRegObj.Value
    End If
    Set clsRegObj = Nothing
End Function
0
 
Ashish PatelCommented:
Finally make use of the function

SetGetRegistryValue "Set", "MyKey", REG_BINARY, "62 00 01 00 01 00"
SetGetRegistryValue "Get", "MyKey", REG_BINARY
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Father-Of-TimeAuthor Commented:
I really appreciate your help
But i already have a code that allow me to read and write registry keys.

What i need is a way on how to set the an exact value to the registry.
In this case the value i need to set in the registry is this: "62 00 01 00"

Do you know anything about it?

Thanks in advance
0
 
Father-Of-TimeAuthor Commented:
Oh! i see now,
Let me try to see it in action.
0
 
Father-Of-TimeAuthor Commented:

Hello there, i am trying your code, this is how am doing it...

Private Sub Command1_Click()
SetGetRegistryValue "Set", "HKEY_CURRENT_USER\Software\MyKey\MyKey", REG_BINARY, "62 00 01 00 01 00"
End Sub

But i get a run-time error message

Can you please tell me if this is ok?

Thank you
0
 
Ashish PatelCommented:
Follow the steps
1. Create a class file with name RegistryAction
2. Place the function SetGetRegistryValue below Command1_Click()
3. Create a registry key under software with name MyKey
4. Create a Binary value under Software/MyKey with name BinVal
5. use the below
Private Sub Command1_Click()
SetGetRegistryValue "Set", "HKEY_CURRENT_USER\Software\MyKey\BinVal", REG_BINARY, "62 00 01 00 01 00"
End Sub

0
 
Ashish PatelCommented:
And please debug the program and see what you are doing wrong if its still giving error. I am moving out of office, but the registry editing class is one globally used API class. And i have been using the same since last 7 years without issues.
0
 
Father-Of-TimeAuthor Commented:
The code doesn't work
The name of the class i knew about it
so i named to the giving name of the Class
I know i doing it ok right now, but i still getting an error.
0
 
Ashish PatelCommented:
try debugging and let me know which line gives you error and what is the error.
0
 
Father-Of-TimeAuthor Commented:
Look i have a code that set binary code to the registry
But the problem is that if i try to set this: "62 00 01 00 01 00"
I will then get this result of the binary:    "62 2e 2e 2e 2e 2e"
So i got the feeling that it will happen the same with your code.

But the problem now is to make your code work, cus is not working.
0
 
Father-Of-TimeAuthor Commented:

Sorry but i don't know how to implement the Debug.Print in this example.
0
 
Father-Of-TimeAuthor Commented:

The only thing i can tell you is the run-time error message
It point to this part in the Class: Err.Raise 26001
In debug mode it also point to this: Err.Raise 26001

This is the whole run-time error message:

Run-time error '26001':

Application-defined or object-defined error

0
 
Ashish PatelCommented:
Okay so the key which you are create is wrong here in registry. Make sure you have created the key in
the following path

My Computer\HKEY_LOCAL_MACHINE\Software\MyKey\BinVal
0
 
Ashish PatelCommented:
because what you are looking at is in the function. Please open regedit and look the path where you have create the key in status bar and provide the same. In my function which i gave is the HKEY_LOCAL_MACHINE and you are looking at the path HKEY_CURRENT_USER. So please change the function call to this and try

SetGetRegistryValue "Set", "HKEY_LOCAL_MACHINE\Software\MyKey\MyKey", REG_BINARY, "62 00 01 00 01 00"
0
 
Ashish PatelCommented:
Like This.
Private Sub Command1_Click()
SetGetRegistryValue "Set", "HKEY_LOCAL_MACHINE\Software\MyKey\BinVal", REG_BINARY, "62 00 01 00 01 00"
End Sub
0
 
Father-Of-TimeAuthor Commented:

See, the thing here is that, this key was never create it
("\HKEY_LOCAL_MACHINE\Software\MyKey\BinVal")

Now this is the key you told me to write to the registry:

Private Sub Command1_Click()
SetGetRegistryValue "Set", "HKEY_CURRENT_USER\Software\MyKey\BinVal", REG_BINARY, "62 00 01 00 01 00"

This is the key ive trying to write to the registry, but i can!
How am i going to make or create the key if the code is giving me errors?


End Sub
0
 
Ashish PatelCommented:
So create a key in HKEY_LOCAL_MACHINE in your regedit first manuall and then

replace HKEY_CURRENT_USER with HKEY_LOCAL_MACHINE in the function i gave you and in your command1_click() sub routine too. this should solve the issue. and moreover you would be able to create a key and value in HKEY_LOCAL_MACHINE of your machine.
0
 
Father-Of-TimeAuthor Commented:
Look, everything looks pretty neat here
I did everything the way you told me to.

1.) I Start a new project.
2. I dd one Command Buttom and one Class module, Class name: RegistryAction
3.) The finnally i run the project.

This looks very simple, but it looks also neat, so what can be wrong?

I don't get it.





1. Class module
2. Paste this whole thing in this class
3.
0
 
Father-Of-TimeAuthor Commented:

Still debug to this point in the Class: Err.Raise 26001
0
 
Ashish PatelCommented:
just a min, i found the cause for you. getting if fixed for your use.
0
 
Father-Of-TimeAuthor Commented:

Take a look at this, if i leave only this in the main Form

Option Explicit

Private Sub Command1_Click()
SetGetRegistryValue "Set", "HKEY_LOCAL_MACHINE\Software\MyKey\BinVal", REG_BINARY, "62 00 01 00 01 00"
End Sub

I get this error message:

Compile error:
Sub or Function not defined


Then if i try to run the project this way...

Option Explicit

Function SetGetRegistryValue(SetOrGet As String, l_ValueKey As String, l_ValueType As Variant, Optional l_Value As Variant) As String
Dim clsRegObj As New RegistryAction

clsRegObj.ClassKey = HKEY_LOCAL_MACHINE
clsRegObj.SectionKey = "Software\Subscription"
clsRegObj.ValueKey = l_ValueKey
clsRegObj.ValueType = l_ValueType
If SetOrGet = "Set" Then
clsRegObj.Value = l_Value
Else
SetGetRegistryValue = clsRegObj.Value
End If
Set clsRegObj = Nothing
End Function

Private Sub Command1_Click()
SetGetRegistryValue "Set", "HKEY_LOCAL_MACHINE\Software\MyKey\BinVal", REG_BINARY, "62 00 01 00 01 00"
End Sub

Then i get this other error message:

Run-time error '26001':

Application-defined or object-defined error

0
 
Ashish PatelCommented:
Basically the value which we are passing "62 00 01 00 01 00" is in string instead of Binary array.
0
 
Ashish PatelCommented:
The function you should use is this

Function SetGetRegistryValue(SetOrGet As String, l_ValueKey As String, l_ValueType As Variant, Optional l_Value As Variant) As String
Dim clsRegObj As New RegistryAction

clsRegObj.ClassKey = HKEY_LOCAL_MACHINE
clsRegObj.SectionKey = "Software\MyKey"
clsRegObj.ValueKey = l_ValueKey
clsRegObj.ValueType = l_ValueType
If SetOrGet = "Set" Then
clsRegObj.Value = l_Value
Else
SetGetRegistryValue = clsRegObj.Value
End If
Set clsRegObj = Nothing
End Function

But as the value should be in binary array.
0
 
Ashish PatelCommented:
Can you please have a look at this and make use of it for yourself.

http://www.xtremevbtalk.com/archive/index.php/t-251871.html
0
 
Ashish PatelCommented:
So, this is final thing to make you understand
bOut is a variable of byte array where you will store all your hex values

Function SetGetRegistryValue(SetOrGet As String, l_ValueKey As String, l_ValueType As Variant, Optional l_Value As Variant) As String
    Dim clsRegObj As New RegistryAction
   
    clsRegObj.ClassKey = HKEY_LOCAL_MACHINE
    clsRegObj.SectionKey = "Software\MyKey"
    clsRegObj.ValueKey = l_ValueKey
    clsRegObj.ValueType = l_ValueType
    If SetOrGet = "Set" Then
        clsRegObj.Value = l_Value
    Else
        SetGetRegistryValue = clsRegObj.Value
    End If
    Set clsRegObj = Nothing
End Function

Private Sub Command1_Click()
Dim bOut() As Byte
ReDim bOut(3)
bOut(0) = &H1
bOut(1) = &H2
bOut(2) = &H3

SetGetRegistryValue "Set", "HKEY_LOCAL_MACHINE\Software\MyKey\BinVal", REG_BINARY, bOut
End Sub

0
 
Father-Of-TimeAuthor Commented:

Look, try my code and see how simple this work

Here is what you need:

1 Bas module
1 Command buttom
3 Text Boxes

Then paste this to the module:

Option Explicit

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
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long

Const REG_BINARY = 3&
Const KEY_QUERY_VALUE = &H1&
Const KEY_SET_VALUE = &H2&
Const KEY_CREATE_SUB_KEY = &H4&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_CREATE_LINK = &H20&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY

Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Dim lDataSize As Long
Dim ByteArray() As Byte

Function SetBinaryValue(SubKey As String, Entry As String, Value As String)
Dim i
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key
lDataSize = Len(Value)
ReDim ByteArray(lDataSize)
For i = 1 To lDataSize
ByteArray(i) = Asc(Mid$(Value, i, 1))
Next
rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value
rtn = RegCloseKey(hKey) 'close the key
End If
End Function

Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
   
Select Case MainKeyName
Case "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
Case "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
Case "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
End Select
End Function

Private Sub ParseKey(KeyName As String, Keyhandle As Long)
rtn = InStr(KeyName, "\") 'Return if "\" is contained in the Keyname
If Left(KeyName, 5) <> "HKEY_" Or Right(KeyName, 1) = "\" Then 'if the is a "\" at the end of the Keyname then
'MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + KeyName 'display error to the user
Exit Sub 'exit the procedure
ElseIf rtn = 0 Then 'If the Keyname contains no "\"
Keyhandle = GetMainKeyHandle(KeyName)
KeyName = "" 'Leave Keyname blank
Else 'Otherwise, Keyname contains "\"
Keyhandle = GetMainKeyHandle(Left(KeyName, rtn - 1)) 'Seperate the Keyname
KeyName = Right(KeyName, Len(KeyName) - rtn)
End If
End Sub

Finally add this to the main Form

Private Sub Command1_Click()
SetBinaryValue Text3, Text2, Text1
End Sub

Now in each of the text boxes write the path to the key
it will be something like these...

Text3: HKEY_CURRENT_USER
Text2: MyKey
Text1: BinVal

In text1 write ehat ever you want and check it out how simple this is
The problem is that i can't set the value i want

0
 
Father-Of-TimeAuthor Commented:
This time your code did work :-)
Now i ask you, how can i make it set this value?
===>  "62 00 01 00"
0
 
Ashish PatelCommented:
Okay the problem within your code is you  are converting every characters to asc instead of their real Hex code of the Value. The line is:
ByteArray(i) = Asc(Mid$(Value, i, 1))

So instead of asc try finding something which can convert your string value "b...." to Hex code and not asc.
0
 
Ashish PatelCommented:
Convert this "62 00 01 00" to its Hex. By the just to make sure
 "62 00 01 00" converts to "b...."...right?
0
 
Ashish PatelCommented:
Okay final touch.

Use this and your binary value is all set.

Function SetGetRegistryValue(SetOrGet As String, l_ValueKey As String, l_ValueType As Variant, Optional l_Value As Variant) As String
    Dim clsRegObj As New RegistryAction
   
    clsRegObj.ClassKey = HKEY_LOCAL_MACHINE
    clsRegObj.SectionKey = "Software\MyKey"
    clsRegObj.ValueKey = l_ValueKey
    clsRegObj.ValueType = l_ValueType
    If SetOrGet = "Set" Then
        clsRegObj.Value = l_Value
    Else
        SetGetRegistryValue = clsRegObj.Value
    End If
    Set clsRegObj = Nothing
End Function

Private Sub Command1_Click()
Dim bOut() As Byte
ReDim bOut(5)
bOut(0) = &H62
bOut(1) = &H0
bOut(2) = &H1
bOut(3) = &H0
bOut(4) = &H0
SetGetRegistryValue "Set", "BinVal", REG_BINARY, bOut
End Sub

0
 
Father-Of-TimeAuthor Commented:
Yes, thats right
0
 
Ashish PatelCommented:
For your exact code which you wanted. Hope you are good now. bOut is the byte array.

Private Sub Command1_Click()
Dim bOut() As Byte
ReDim bOut(8)
bOut(0) = &H62
bOut(1) = &H0
bOut(2) = &H1
bOut(3) = &H0
bOut(4) = &H0
bOut(5) = &H1
bOut(6) = &H0
bOut(7) = &H0

SetGetRegistryValue "Set", "BinVal", REG_BINARY, bOut
End Sub
0
 
Father-Of-TimeAuthor Commented:
Yeah :-) this is nice, this is what i wanted.
If in the future i need to change this value,
Can you please give me any idea on how to make my own?

bOut(0) = &H62
bOut(1) = &H0
bOut(2) = &H1
bOut(3) = &H0
bOut(4) = &H0

Thanks
0
 
Father-Of-TimeAuthor Commented:
Thank you man, i will now accept you answer, I really appreciate all your help.
I will now increase the points to 100 more, if i had more, i'll increase it to 500, but thats all i have for now.
0
 
Ashish PatelCommented:
Okay thanks. and please let me know name too.
0
 
Father-Of-TimeAuthor Commented:
Thank You!

Sincerelly, Sam
0
 
Father-Of-TimeAuthor Commented:
Hello there asvforce
Do you know how can i change

ByteArray(i) = Asc(Mid$(Value, i, 1))

To

ByteArray(i) = Hex(Mid$(Value, i, 1))

I will be very appreciate

Thank You
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 21
  • 18
Tackle projects and never again get stuck behind a technical roadblock.
Join Now