How to read a unicode registry value?

Outlook 2003, Windows XP.

How do you read a value from the registry that is a Unicode string stored as
REG_BINARY?

I'm working on a little thing to automatically cycle through my signatures
in my emails but the current signature is specified by a registry value such
that the name of the signature file is Unicode that has been taken as though
it were a block of binary values.

For example, the signature "2 Wrongs" is specified in the registry as

Name - New Signature
Type - REG_BINARY
Data - 32 00 20 00 57 00 72 00 6f 00 6e 00 67 00 73 00 00 00

So - in VBA, how do I read and convert to a string and, more importantly,
how do I take a string and convert into the REG_BINARY block it wants?
===
Richard Lewis Haggard

A Unicode string would have every other character being the ANSI
string character followed by a null string (0x00). You can get that as
a Variant value and use the Replace function to get rid of the nulls
to convert it to a string value: strResult = Replace(1, varResult,
Chr(0)). The ANSI string you want to write would then be converted
into Unicode in the reverse way, by adding 0x00 after each character
in the original string.

Here's some code I used to write some strings as Outlook categories,
which are Unicode in Outlook 2002 or later. I'll only include one
category string to keep the example short. This example hard codes the
path for Outlook 2002 categories, it would be different for Outlook
2003. Terminating the Unicode string is a double null (0x0000).

Public Sub SetMasterCategoryList()
Dim astrCategories(0 To 15) As String 'example only uses 1
Dim strCategoriesPath As String
Dim strCategories As String
Dim varCategories As Variant
Dim lLBound As Long
Dim lUBound As Long
Dim i As Long
Dim j As Long
Dim blnResult As Boolean

On Error Resume Next

strCategoriesPath =
"\Software\Microsoft\Office\10.0\Outlook\Categories"

astrCategories(0) = "Academic"
'and so on

lLBound = LBound(astrCategories)
lUBound = UBound(astrCategories)
strCategories = ""

For i = lLBound To lUBound
For j = 1 To Len(astrCategories(i))
varCategories = varCategories & Mid(astrCategories(i), j, 1) &
Chr(0)
Next j
varCategories = varCategories & ";" & Chr(0)
Next i
varCategories = varCategories & Chr(0) & Chr(0)

blnResult = basRegistry.SetKeyValue(HKEY_CURRENT_USER, _
strCategoriesPath, "MasterList", varCategories, REG_BINARY)
End Sub

'In basRegistry:
Public Const HKEY_CURRENT_USER = &H80000001

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const REG_BINARY As Long = 3

'Error codes
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259

Private Const KEY_ALL_ACCESS = &H3F

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long)
As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) 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 RegSetValueExBinary 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

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

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

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long

Declare Function RegQueryValueExBinary Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
String, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant) As Long

Dim cch As Long
Dim lRC As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

' Determine the size and type of data to be read
lRC = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lRC <> ERROR_NONE Then Error 5

Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lRC = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue,
cch)
If lRC = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lRC = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue,
cch)
If lRC = ERROR_NONE Then vValue = lValue
' For BINARY
Case REG_BINARY:
lRC = RegQueryValueExBinary(lhKey, szValueName, 0&, lType, lValue,
cch)
If lRC = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lRC = -1
End Select

QueryValueExExit:
QueryValueEx = lRC

Err.Clear

Exit Function

QueryValueExError:
Resume QueryValueExExit
End Function

Public Function GetKeyValueEx(lKey As Long, sKeyName As String, _
sValueName As String) As Variant

Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value

On Error GoTo GetKeyValue_Error

lRetVal = OSRegOpenKey(lKey, sKeyName, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
If Len(vValue) Then 'Trim null
If Right$(vValue, 1) = Chr$(0) Then
vValue = Left$(vValue, Len(vValue) - 1)
End If
End If
GetKeyValueEx = vValue
RegCloseKey (hKey)

GetKeyValue_Exit:
Err.Clear

Exit Function

GetKeyValue_Error:
GetKeyValueEx = ""
Resume GetKeyValue_Exit
End Function

Private Function SetValueEx(ByVal hKey As Long, sValueName As String,
_
lType As Long, vValue As Variant) As Long

Dim lValue As Long
Dim sValue As String

On Error Resume Next

Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType,
sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType,
lValue, 4)
Case REG_BINARY
SetValueEx = RegSetValueExBinary(hKey, sValueName, 0&, lType,
vValue, Len(vValue))
End Select

End Function

Public Function SetKeyValue(lKey As Long, sKeyName As String, _
sValueName As String, vValueSetting As Variant, lValueType As Long)
As Boolean

Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
Dim SA As SECURITY_ATTRIBUTES

On Error GoTo SetKeyValue_Error

If Left$(sKeyName, 1) = "\" Then
sKeyName = Mid$(sKeyName, 2)
ElseIf sKeyName = "" Then 'can't have blank key name
SetKeyValue = False
Exit Function
End If

lRetVal = RegCreateKeyEx(lKey, sKeyName, 0, vbNull, 0, _
KEY_ALL_ACCESS, SA, hKey, 0)

If lRetVal = ERROR_NONE Then
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

If lRetVal = ERROR_NONE Then
SetKeyValue = True
Else
SetKeyValue = False
End If
Else
SetKeyValue = False
End If

RegCloseKey (hKey)

SetKeyValue_Exit:
Exit Function

SetKeyValue_Error:
Err.Clear
SetKeyValue = False
End Function

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginners Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Richard Lewis Haggard" <HaggardAtWorldDotStdDotCom> wrote in message
news:u0a2sRu9DHA.1636@TK2MSFTNGP12.phx.gbl...
> Outlook 2003, Windows XP.
>
> How do you read a value from the registry that is a Unicode string
stored as
> REG_BINARY?
>
> I'm working on a little thing to automatically cycle through my
signatures
> in my emails but the current signature is specified by a registry
value such
> that the name of the signature file is Unicode that has been taken
as though
> it were a block of binary values.
>
> For example, the signature "2 Wrongs" is specified in the registry
as
>
> Name - New Signature
> Type - REG_BINARY
> Data - 32 00 20 00 57 00 72 00 6f 00 6e 00 67 00 73 00 00 00
>
> So - in VBA, how do I read and convert to a string and, more
importantly,
> how do I take a string and convert into the REG_BINARY block it
wants?
> ===
> Richard Lewis Haggard
>
>