Register a binary key (REG_BINARY)

[Vntalk]

I really need your help guys. I browse, search around the forums, on google, yup, there are many tutorials on it , but since i'm a newbie, i just can't understand how it's works, could you guys post a working example on it. I thanks.
here's the value of the key:

39,ff,0d,d8,7c,74,a4,7f,73,99,b8,cb,ba,3d,b1,44,c9,71,\
63,4c,ca,fe,2f,cc
.... and so on

[schoolbusdriver]

You'll have to be more specific. That looks like it was exported from the registry using regedit. Why not just merge the key ? i.e. export it to a file, say, "C:\Temp\MySettings.reg" then:-

'  /s means silent mode merging.

regedit /s C:\Temp\MySettings.reg

If you want to do it in VB use ShellExecute:-

Option Explicit
 
'Form level code.
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
   (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Const SW_HIDE = 0
 
Private Sub Form_Click()
   Dim retval As Long
 
'Merge it without confirmation messages.
   retval = ShellExecute(Me.hwnd, "open", "regedit.exe", "/s C:\Temp\MySettings.reg", vbNullString, SW_HIDE)
End Sub

[rory]

i was looking all night also for a solution to this ..

anyway finally found a Hex function from a member on this forum, and then used some existing code i had plus integrated what i found on VB Accelerator to come up with this ..

Maybe this will help someone else save some time ..

Notice how the Data is passed to the Save Procedure as a Variant to accomodate Arrays as well as other types.

Option Explicit
 
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
 
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
 
' STRING
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
 
' 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
 
' BYTE
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 Const m_HCU As Long = &H80000001    'LOCAL MACHINE
Private Const m_HLM As Long = &H80000002    'CURRENT USER
 
' REGISTRY VALUES
Public Enum regTypes
   ValNull = 0
   ValString = 1
   ValXString = 2
   ValBinary = 3
   ValDWord = 4
   ValDWordLE = 4
   ValDWordBE = 5
   ValLink = 6
   ValMultiString = 7
   ValResList = 8
End Enum
 
' CLICK TO OPEN VALUES
Public Enum enClickToOpen
    ctoDouble = 1
    ctoSingle = 0
End Enum
 
' Single or Double Click on Items
Public Property Let ClickToOpen(ByVal inNew As enClickToOpen)
    Dim bArr() As Byte
    If inNew = ctoDouble Then    'double click
        bArr = Hex2ByteArr("2400000033a80000000000000000000000000000010000000d0000000000000000000000")
        Save_Value m_HCU, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", bArr, ValBinary
    Else                         'single click
        bArr = Hex2ByteArr("2400000013a80100000000000000000000000000010000000d0000000000000002000000")
        Save_Value m_HCU, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", bArr, ValBinary
    End If
End Property
 
' SAVE / UPDATE REGISTRY VALUE
Private Sub Save_Value(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, _
ByVal varData As Variant, ByVal ValType As regTypes)
    Dim keyhand As Long
    Dim lResult As Long
    Dim ordType As Long
    Dim c       As Long
    lResult = RegCreateKey(hKey, strPath, keyhand)
    If lResult Then
        'error
    Else
        Select Case ValType
            ' BINARY VALUE (BYTE ARRAY)
            Case ValBinary
                If (VarType(varData) = vbArray + vbByte) Then
                    Dim ab() As Byte
                    ab = varData
                    c = UBound(ab) - LBound(ab) + 1
                    lResult = RegSetValueExByte(keyhand, strValue, 0&, ValType, ab(0), c)
                Else
                    'error
                End If
            ' DWORD VALUE (INT/LONG)
            Case ValDWord, ValDWordBE, ValDWordLE
                If (VarType(varData) = vbInteger) Or (VarType(varData) = vbLong) Then
                    Dim i As Long
                    i = varData
                    ordType = ValDWord
                    lResult = RegSetValueExLong(keyhand, strValue, 0&, ordType, i, 4)
                Else
                    'error
                End If
            ' STRING VALUE
            Case ValString, ValXString
                Dim s As String, iPos As Long
                s = varData
                ordType = ValString
                iPos = InStr(s, "%")
                If iPos Then
                    If InStr(iPos + 2, s, "%") Then ordType = ValXString
                End If
                c = Len(s) + 1
                s = s & vbNullChar
                lResult = RegSetValueExString(keyhand, strValue, 0&, ordType, s, c)
            Case Else
                'error
        End Select
        If lResult Then
            'error
        End If
        RegCloseKey keyhand
    End If
End Sub
 
' HEX TO BYTE ARR - Joacim Andersson
Private Function Hex2ByteArr(ByVal sHex As String) As Byte()
    Dim n As Long
    Dim nCount As Long
    Dim bArr() As Byte
    'First of all, make sure the length of the hex string is even, if it is not then
    'put a "0" at the beginning
    nCount = Len(sHex)
    If (nCount And 1) = 1 Then
        sHex = "0" & sHex
        nCount = nCount + 1
    End If
    'ReDim the Byte array
    ReDim bArr(nCount \ 2 - 1) 'we subtract 1 since the array is zero based
    For n = 1 To nCount Step 2
        'Convert the hex numbers into decimal values and store them in the byte array
        bArr((n - 1) \ 2) = CByte("&H" & Mid$(sHex, n, 2))
    Next
    'Return the array
    Hex2ByteArr = bArr
End Function

Since this is a Class File in my case, I call i like this in my app ..

Dim appe As cTweak
    Set appe = New cTweak
        appe.ClickToOpen = ctoDouble
    Set appe = Nothing

[schoolbusdriver]

i was looking all night also for a solution to this ..

You should have asked . I have ready code for just about any registry manipulation anyone can think of ... (Including renaming/copying a registry subkey in just 3 lines of code). Simply wanted Vntalk to prove he'd made an effort...

[rory]

You should have asked . I have ready code for just about any registry manipulation anyone can think of ... (Including renaming/copying a registry subkey in just 3 lines of code). Simply wanted Vntalk to prove he'd made an effort...

Im stubborn .. dont like to ask unless its a last resort ..
but would have saved some of my hair in this case .. was pulling it all out all night long ..

[schoolbusdriver]

Im stubborn .. dont like to ask unless its a last resort ..