Tuesday, October 20, 2015

LotusScript: Binary Registry Values Made Easy

Originally published 

Wed 27 Aug 2008

Editors Notes
One of the truly "hard won" bits of knowledge.  I spent the better part of a day or two getting this to work out just right.  It was such a bizzar requirement, but at long last, there was a way to get what the customer wanted.

Original Post

For a long time, you've (probably) known that you can use the Windows Scripting host to read and write string values to and from the Windows Registry. With it, you can also read and write short REG_BINARY values. But in some cases, you need to write long arrays of REG_BINARY data to the registry and the Windows Scripting host won't help you.
First, the obligatory back-story. I've been working on a very particular click saving requirement the past three days for my current customer. Simply put, when program X file save dialog is activated, it should automatically be in the predesignated folder. Easy enough when you are calling the File Save dialog yourself, not so easy when you are shelling a program and waiting for it to raise the File Save itself.
I spent considerable time playing with the RegSetValueEX API function found in the advapi.dll. (Considerable time means you're getting quite a bargain just for the price of reading this article.) I eventually got to the point where I could get it to write REG_BINARY values, but there was a problem. My data looked like this.
0000 28 89 DB 04 10 89 DB 04
0008 BF 05 00 00 0E 00 00 00
0010 01 00 01 00 07 00 00 00
0018 B8 CC BB 08 00 00 36 00
0020 00 00 00 00 70 64 66 77
0028 72 69 74 65 72 2E 65 78
0030 65 20 63 3A 5C 
That 70 I have highlighted at address 0024 should be at address 0000. Wondering about the addresses? Think Hex. In Hexadecimal, 0010 is not 2 greater than 0008, it's 8 greater. (0008 0009 000a 000b 000c 000d 000e 000f 0010). I have no idea where the garbage characters preceding my data came from, but they were pretty consistent regardless of whether I passed ASCII or HEX values.
After much research, I found mention of the Windows Management Instrumentation COM object on an MSDN article. Based on that example, I created the class shown below which provides you a simple and easy way to send up a string and have it properly inserted into the registry so that up at position 0000, we would see the expected hex value 70. Here's what it should have looked like.

0000 70 00 64 00 66 00 77 00
0008 72 00 69 00 74 00 65 00
0010 72 00 2E 00 65 00 78 00
0018 65 00 00 00 43 00 3A 00
0020 5C 00 49 00 6D 00 61 00
0028 67 00 65 00 73 00 5C 00
0030 78 00 78 00 31 00
Notice also, the characters are spaced apart with an empty byte. At this point, I'm really not totally sure why. What we see here are the hex values of the ASCII values derived from the input string. A spacer provides enough room that you could put a Unicode value within the Basic Multilingual Plane across the four positions. I'm still learning about Unicode and the windows registry itself, though, so I could be way off there. What I do know is I put hex in, and get decimal ASCII values back, which is strange - I would have though, hex in, hex out... but then again it's Windows. :-)
WMI Wrapper Class
This ONLY wraps the functionality discussed above. Have fun, and be careful.

Class WMIWrapper
 Public wmi As Variant
 Public haserr As Boolean
 Public lasterr As String
 
 Sub new()
  Dim strComputer As String
  strComputer = "."
  
  Set Me.wmi=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") 
  
 End Sub
 
 Public Function writeBinRegKey(regnode As Variant, keypath As String, keyname As String, keyvalue As String) As Boolean
  On Error Goto eh
  Dim sValues() As String  
  Call makeHexArray(keyvalue,sValues)  
  Me.wmi.CreateKey regnode, keypath  
  Me.wmi.SetBinaryValue regnode,keypath,keyname,sValues
  writeBinRegKey = True
  Exit Function
eh:
  writeBinRegKey = False
  Me.haserr = True
  Me.lasterr = "public function writeBinRegKey - " + Error + " at " + Cstr(Erl)
  Exit Function
 End Function
 
 Public Function readBinRegKey(regnode As Variant, keypath As String, keyname As String) As String
  On Error Goto eh
  Dim sValues As Variant
  Me.wmi.GetBinaryValue regnode, keypath, keyname, sValues
  readBinRegKey = AscArrToString(sValues)
  Exit Function
eh:
  Me.haserr = True
  Me.lasterr = "public function readBinRegKey - " + Error + " at " + Cstr(Erl)
  Exit Function
 End Function
 
 Private Function AscArrToString(ascArr As Variant) As String
  On Error Goto eh
  Dim i As Long
  Dim buff As String
  
  For i = 0 To Ubound(ascArr)
   If Not ascArr(i) = 0 Then
    buff = buff + Chr(ascArr(i))
   End If
  Next
  AscArrToString = buff
  Exit Function
eh:
  Msgbox "Error in AscArrToString - " + Error + " at " + Cstr(Erl)
  Exit Function
 End Function
 
 
 Private Sub makeHexArray(inputstr As String,tmparr() As String)
  On Error Goto eh
  Redim tmparr(0)
  Dim i As Long
  Dim tmpasc As String
  Dim tmpstr As String
  Dim pos As Long
  pos =1
  For i = 1 To Len(inputstr)*2
   Redim Preserve tmparr(i-1)
   If (i-1) Mod 2 = 0 Then
    tmpstr = Right(Left(inputstr,pos),1)    
    tmpasc = "&H" + Cstr(Hex$(Cstr(Asc(tmpstr))))    
    tmparr(i-1) = tmpasc
    pos = pos + 1
   Else
    tmparr(i-1) = "&H" + Cstr(Hex$(0))
   End If   
  Next   
  Exit Sub
eh:
  Me.haserr = True
  Me.lasterr = "private sub: makeHexArrap - " + Error + " at " + Cstr(Erl)
  Exit Sub
 End Sub
End Class

No comments:

Post a Comment