The Registry Made Easy

This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.

VBA Hacker

A Classy Way to Bypass the Awkward Registry API

By Romke Soldaat

Compared with the bad old INI files, the Windows registry is not only a safer place for system and application settings, it also offers more ways to store different types of data, and lets you organize your settings in a hierarchical manner. But, unlike the straightforward functions that deal with INI files, the registry API is more complex. You can't just read and write data with a single function call - you must open a key before you can access it, and close the key when you're done with it. That's why Microsoft gave Visual Basic programmers a set of one-step routines that simplify their lives: SaveSetting, GetSetting, GetAllSettings, and DeleteSetting. When you use these statements and functions, you don't have to worry about opening and closing keys; VB takes care of that in the background. The only problem is these routines are too limited for power users.

VB restricts registry access to the "HKEY_CURRENT_USER\Software\VB and VBA Program Settings" key. There's no way you can use VB to retrieve a value from any other location. Apart from that, VB functions can only cope with string settings. SaveSetting stores numbers as strings, whether you like it or not. If you use GetSetting to retrieve a numeric (i.e. DWORD) value, you're punished with an "Invalid procedure call or argument" error. If you use GetAllSettings, and one or more values under the specified key isn't a string, your code crashes with the same error. And if you call DeleteSetting to delete a key that contains subkeys, again you're accused of being an ignorant programmer. That's bad.

Wrapping the Win API

These VB limitations force serious developers to stick with the Windows registry API. Fortunately, you can avoid the complexity of these functions by wrapping the nitty-gritty into a class module. Once the class is part of your application, you can create an object, access its properties and methods, and forget about API functions altogether.

I've explored many Web sites and books for registry classes and libraries, but didn't find a single one that came close to my demands. Most limit themselves to getting and setting string values, just like VB. A few allow for the storage of numeric values, but none I've seen let you deal with environment variables or arrays. And all of them make the mistake of allowing you to overwrite values with new ones of a different data type.

Most "solutions" (including the ones produced by Microsoft!) were built on the premise that everything in the registry is accessible for any operation. However, under Windows NT/ 2000, parts of the registry may have restricted access rights. So if you simply want to read a value, you shouldn't ask for full access. You might not get any.

Therefore, I decided to write my own RegOp (short for Registry Operation) class. It's included in the download file (see end of article for details). This article explains how it works, and how you can use it in your applications.

First, however, let's look at how the registry API works. An extensive description of each API function and its parameters would go beyond the scope of this article, but you can find them on the MSDN CD-ROM, and on the Microsoft Web site. Refer to Listing One for the declarations of the functions involved in the class.

Registry Basics

The Windows registry is a database that contains settings for the operating system and installed applications. These settings are stored under a number of root keys. The RegOp class supports the three roots you're most likely to use; see FIGURE 1.

FIGURE 1: Registry roots supported by the RegOp class.

Under each key, the registry contains a tree of subkeys, and each subkey can hold values, identified by unique value names. Each subkey can also hold one unnamed "default" value (which must be a string). Values can be stored in a number of formats. FIGURE 2 provides an overview of the data types supported by the RegOp class. There are other data types, but they're irrelevant for VB programmers, so I'll ignore them here.

FIGURE 2: Registry data types supported by RegOp**.**

Registry ethics. If you have access to all parts of the registry, you probably don't want to use the "Software\VB and VBA Program Settings" key under HKCU. The commonly accepted rule is that you create a key with your company name under the "Software" key in both HKLM and HKCU. For each application you create a separate key under your company key. The HKLM branch is used for application-specific information (usually created at setup), and user-specific settings go under HKCU. Here's the blueprint:

HKEY_LOCAL_MACHINE\Software\My Company\My Application
HKEY_CURRENT_USER\Software\My Company\My Application

Opening and Closing Keys

Before you can access a registry key, you must open it. Two API functions let you do this: RegOpenKeyEx and RegCreateKeyEx. The class uses RegCreateKeyEx, because this function automatically creates a key if it doesn't exist, and then opens the key. If the key already exists, the function simply opens it.

Each of these functions gives you a handle to the open key. You need this handle to access the information under the key. Once you're done, you pass the handle to the RegCloseKey function.

Access rights and security. Under Windows NT and 2000, a system administrator may restrict access to parts of the registry. The level of restriction is determined by a combination of parameters. If the current Windows version is NT 4.0 or 2000, the RegOp class only asks for access rights that are relevant for the desired operation: KEY_READ to query and enumerate values, KEY_WRITE to create keys and values, and KEY_ALL_ACCESS to delete values or keys. The values of these constants are shown in Listing One.

Setting, Getting, and Deleting Values

To write a value to the registry, use the RegSetValueEx function. Specify the value name, the data type (one of the values shown in FIGURE 2), the data itself, and a value that specifies the size (in bytes) of the data you're storing. When you save a DWORD value, you specify the data by reference; in all other cases you do it by value.

The RegQueryValueEx function retrieves a value. If you know the data type of the value, you can specify the type directly and retrieve the value from a buffer you've created. If you're not sure about the data type, call the function first to receive the data type in a variable, then call the function again using this variable as the parameter that specifies the data type. The RegOp class, however, bypasses RegQueryValueEx. The first time you query a value, the class retrieves all values under the specified key at once, using the RegEnumValue function. (More about that later.)

It takes a simple call to the RegDeleteValue function to get rid of a specified value. There are no complicated parameters involved.

It's a bit trickier to delete an entire key. The RegDeleteKey function works fine under Windows 95/98, but under Windows NT/2000 this function won't delete a key if it contains subkeys. The standard solution is to recursively delete a key. In other words, delete the last branch that doesn't have subkeys, and then go up the tree, deleting every branch on your way until you get to the key you want to delete. That's a cumbersome process. The RegOp class takes a different approach by calling the SHDeleteKey key in the Shlwapi.dll file. This function deletes a key and all its values and subkeys, even under Windows NT/2000. There's a small sticking point: SHDeleteKey works only under Windows NT 4.0, if Internet Explorer 4.0 is also installed (Shlwapi.dll comes standard with Windows 2000). The class checks to see if Shlwapi (short for Shell Lightweight API) is available. If so, it uses the SHDeleteKey function; if not, the SHDeleteKey function is called.

Enumerations

VB's GetAllSettings function enumerates settings under a specified key, and returns a two-dimensional variant array containing the value names and their associated data. As I mentioned earlier, the function can only access a small portion of the registry, and fails as soon as it finds a value that isn't a string. But we should be able to do one better.

The registry API comes with two enumeration functions: RegEnumKeyEx enumerates all subkeys of a key, RegEnumValue enumerates all values. Both functions have a dwIndex parameter. The common way to enumerate keys or values is to start with a zero dwIndex value, and increment this value until there are no more subkeys or values. The class does things differently. Before any enumerations take place, it calls the RegQueryInfoKey function, which returns a host of details about a key, including the number of subkeys and values. This allows the class to use a simple For structure to get all keys and values.

Unlike RegEnumKeyEx, RegEnumValue returns more than just names; it also gives you the data associated with each value name, and the size (in bytes) of the data. The RegOp class calls RegEnumValue the first time you query a value, and creates a mini-database of value names and data in a Dictionary object. The next time you query a value under the same key, the class doesn't have to go back to the registry, but can pull the value directly out of the database.

What's a Dictionary?

In their infinite wisdom, our friends in Redmond decided to create something better than a Collection object - and they named it Dictionary. So, if you're an Office programmer, you now have two types of Dictionary objects at your disposal: the spelling Dictionary objects that are part of Word, and the Dictionary object, exposed by VBScript (the Microsoft Visual Basic Scripting Edition). Confused? You're not the only one!

The VBScript Dictionary object has nothing to do with spelling or grammar. In short, Dictionary is a high-performance data storage object that can contain sets of pairs, each consisting of an item (which can be any data type), and a unique key (usually a string). Unlike a Collection, a Dictionary object exposes an Exists method (so you never have to guess), a CompareMode property (so you can make case-sensitive or case-insensitive searches), and a RemoveAll method.

There's no space here to discuss all the ins and outs of the Dictionary object, so I'll limit myself to the basics as they're used in the RegOp class. The class uses Dictionary as the database that contains the names and data of all values under a key. To create a Dictionary object, you call the CreateObject function. In the following example, the object variable is named ValueList:

Set ValueList = CreateObject("Scripting.Dictionary") 

To add pairs of keys and items, you can use the Add method, but you don't have to. If you assign a value to a key that doesn't exist, the Dictionary object creates the key automatically. The following instructions have the same result:

ValueList.Add "MyValueName", "MyValue" 
  ValueList("MyValueName") = "MyValue" 

The advantage of the second syntax is that it allows you to replace the item associated with an existing key (the first line will generate an error if there is already a "MyValueName" key).

Once you've added your key/item pairs to Dictionary, the Count property tells you how many pairs are stored. The Keys and Item methods return arrays containing all existing keys and items, respectively.

Since Dictionary indexes all data alphabetically by key names, you can make very fast searches and retrievals, as shown here:

If ValueList.Exists("MyValueName") Then_
  MsgBox ValueList("MyValueName") 

As I said before, the RegOp class uses Dictionary to store all pairs of value names and values when the first query comes in. From that point onwards, all subsequent values are retrieved from Dictionary. This may be overkill in cases where you want to retrieve only a single value, but it's a serious performance booster if you need more (or all) values from the same registry key.

Using the RegOp Class

The RegOp class is designed to be easy to use. Once the class module is added to your project, you can create an object with the following instructions:

With New RegOp
   ' ... properties and methods go here. 
End With

In the first line, the object is created, and the Class_Initialize routine in the module is executed. In the last line, the object is deleted, forcing the Class_Terminate routine to run.

Specifying the registry address. The minimal information the class needs is the desired location in the registry. This is determined by two properties: Root and Key. These properties must be specified before you use any other property or method. Root is an enumeration value you can pick from a list. The options are listed in FIGURE 1. If you don't specify a value, the class defaults to HKEY_CURRENT_USER. Key is required, and must be a string. Here are two examples:

' Accessing the Printers key under HKLM. 
.Root = HKEY_LOCAL_MACHINE
.Key = "System\CurrentControlSet\Control\Print\Printers" 
  'Accessing the FrontPage key under HKCU
'(no need to specify a Root value). 
.Key = "Software\Microsoft\FrontPage" 

Setting a value. Once the Root and Key properties are set, you use the Value property to store a value. The name of the value must be specified as an argument, the value itself can be a string, a number, a date, or even an array (more about arrays later). The class analyzes the data type of the value, and stores it in the appropriate format. If you omit the value name, the default value of the specified key is set. In that case the value is saved as a string. Here are some examples:

' Creating named values. 
.Value("Name") = "Romke"         ' Stored as REG_SZ
.Value("Age") = 52               ' Stored as REG_DWORD
.Value("Windows") = "%windir%"   ' Stored as REG_EXPAND_SZ
.Value("Last Use") = Now         ' Stored as REG_SZ
' Setting the default value of a key: 
.Value = "ABC"                   ' Stored as REG_SZ

Retrieving a value. Evaluate the Value property to obtain the data associated with a value name. The value name must be specified as an argument; if omitted, the default value of the key is returned. The data is returned as a Variant:

' Retrieving a named value. 
MyName = .Value("Name") 
' Retrieving the default value of a key. 
DefVal = .Value

Deleting a value. Use the DeleteValue method to remove a name/value pair. The value name must be specified as an argument; if omitted, the default value of the key is returned. If you call this method as a function, the return value is True if the deletion was successful, or False if not. For example:

' Deleting a named value. 
.DeleteValue("Name") 
' Deleting the default value of a key. 
.DeleteValue
' Using DeleteValue as a function. 
If .DeleteValue("Name") = False Then
  MsgBox "Could not delete value" 
End If

Deleting a key. To delete a key and all its descendants, use the DeleteKey method. This method attempts to delete the last component of the key specified with the Key property. If you call this method as a function, the return value is True if the deletion was successful, or False if not. In the following examples, the "My App" key (including all its values and subkeys) is deleted:

.Key = "Software\My Company\My App" 
.DeleteKey
' Using DeleteKey as a function. 
If .DeleteKey = True Then
  MsgBox "Key successfully deleted" 
End If

Obtaining a list of keys. The AllKeys property returns a Variant array of all subkeys under the key specified with the Key property. If there are no subkeys, AllKeys returns Empty. FIGURE 3 demonstrates how you can use this property to get a list of all local printers. The listing in FIGURE 4 uses a different approach to get the same information.

Sub GetAllPrinters()
  With New RegOp
    .Root = HKEY_LOCAL_MACHINE
    .Key = _
      "System\CurrentControlSet\Control\Print\Printers" 
     Dim AllPrinters As Variant, i As Integer, Msg As String
    AllPrinters = .AllKeys
     If Not IsEmpty(AllPrinters) Then
       For i = LBound(AllPrinters) To UBound(AllPrinters) 
        Msg = Msg & AllPrinters(i) & vbCr
       Next
      MsgBox Msg
     End If
  End With
End Sub

FIGURE 3: Getting a list of all locally installed printers. The IsEmpty function is called to test for valid entries, and the For loop uses LBound and UBound to obtain the boundaries of the variant array.

Sub GetAllPrinters2()
  With New RegOp
    .Root = HKEY_LOCAL_MACHINE
    .Key = _
      "System\CurrentControlSet\Control\Print\Printers" 
     Dim MyPrinter As Variant
     If .KeyCount > 0 Then
       For Each MyPrinter In .AllKeys
        Msg = Msg & MyPrinter & vbCr
       Next
      MsgBox Msg
     End If
  End With
End Sub

FIGURE 4: An alternative for the listing in FIGURE 3. The KeyCount property is evaluated, and a For Each loop is used to enumerate the printers.

Obtaining a list of values. The AllValues property returns a Variant array of all value names and their associated data under a key. If there are no values, AllValues returns Empty. FIGURE 5 demonstrates how you can use this property to retrieve all user settings of Word 2000.

Sub GetWordOptions()
  With New RegOp
     Dim AllSettings As Variant, i As Integer, Msg As String
    .Key = "Software\Microsoft\Office\9.0\Word\Options" 
    AllSettings = .AllValues
     If Not IsEmpty(AllSettings) Then
       For i = LBound(AllSettings, 1) To_
               UBound(AllSettings, 1) 
        Msg = Msg & AllSettings(i, 0) & " = " & _
              AllSettings(i, 1) & vbCr
       Next
       MsgBox Msg
     End If
  End With
End Sub

FIGURE 5: Getting all Word settings for the current user. Since these values are stored under HKEY_CURRENT_USER, no Root property needs to be specified.

Storing and Retrieving Arrays

The registry API allows for an interesting data type, called REG_MULTI_SZ. This format lets you store multiple text strings under a single value name. The array is stored in a space-saving binary format. The RegOp class fully supports REG_MULTI_SZ values.

The Windows concept of an "array" differs from what VB considers an array. Windows wants the substrings to be separated by null characters, and expects two null characters at the end of the string. In other words, we're dealing with a single string, not a real array.

The class uses the Join function to create the string that contains all the elements of a specified array, and adds two null characters at the end, like this:

MultiString = _
  Join(OriginalArray, vbNullChar) & String$(2, 0) 

This creates a Windows-friendly string, ready to be stored as a REG_MULTI_SZ value. When this value is retrieved from the registry, the trailing double null characters are removed, and the Split function is used to recreate the array:

OriginalArray = Left$(MultiString, InStr( _
  MultiString, String$(2, 0)) - 1) 
OriginalArray = Split(OriginalArray, vbNullChar) 

So much for the class internals. Fortunately, you don't have to worry about it; all you have to do is specify an array as the data for a value, and the rest is taken care of.

How do you use this in your own applications? That depends on your needs and creativity. If your application needs to store several related values for later use, the REG_MULTI_SZ data type saves space in the registry and can speed up data retrieval. For example, if your application has a dialog box (a.k.a. UserForm), you may want to save the dialog box position and size so you can recreate the same view the next time it's displayed. Currently, you probably store the position and size of the dialog as four separate values:

.Value("Left") = Me.Left
.Value("Top") = Me.Top
.Value("Width") = Me.Width
.Value("Height") = Me.Height

Instead, you can use the Array function, and store all values as a single setting:

.Value("Display") = _
  Array(Me.Left, Me.Top, Me.Width, Me.Height) 

Here's another example. If your software needs to keep MRU (Most Recently Used) file lists, you could save them in separate values, with names like "File1", "File2", etc. But you're saving space and time if you create an array of file names, and store the array as a single value:

Dim MRUFile(3) As String
 MRUFile(0) = "Report.doc" 
MRUFile(1) = "Budget.xls" 
MRUFile(2) = "Customers.mdb" 
MRUFile(3) = "Meeting.ppt" 
With New RegOp
  .Key = "Software\Romke\My App" 
  .Value("MRU") = MRUFile
End With

The RegOp class can return REG_MULTI_SZ data in two ways. By default, the class returns the value as a single string, in which the substrings are separated by null characters (the terminating double null characters are removed). If you specify ReturnMultiStringsAsArrays as part of the Options property, the data is returned as an array. The following code demonstrates how you can obtain the array elements, regardless of the Options setting:

Dim MRUFile As Variant, i As Long
 MRUFile = .Value("MRU") 
If Not IsArray(MRUFile) Then
  MRUFile = Split(MRUFile, vbNullChar) 
End If
For i = LBound(MRUFile) To UBound(MRUFile) 
   Debug.Print MRUFile(i) 
Next

Conclusion

The purpose of this series is to demonstrate that there is a lot more to VBA programming than you may think. With a bit of hacking, you can greatly enhance your Office applications, and facilitate your work as a developer. In this installment, I showed you how you can wrap the complex Windows registry API in a class module, so you only have to deal with some simple properties and methods (summarized in FIGURE 6). Watch this space for more VBA hacks!

FIGURE 6: A summary of RegOp properties and methods.

Dutchman Romke Soldaat was hired by Microsoft in 1988 to co-found the Microsoft International Product Group in Dublin, Ireland. That same year he started working with the prototypes of WinWord, writing his first macros long before the rest of the world. In 1992 he left Microsoft, and created a number of successful add-ons for Office. Living in Italy, he divides his time between writing articles for this magazine, enjoying the Mediterranean climate, and steering his Land Rover through the world's most deserted areas. Romke can be contacted at mailto:romke@soldaat.com.

Begin Listing One - RegOp.cls

Option Explicit
 DefStr S
DefLng H-I, L, N
DefVar V
DefBool B
 Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
  Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
  ' RegCreateKeyEx creates the specified key. If the key
' already exists, the function opens it. The phkResult
' parameter receives the key handle. 
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
  'RegCloseKey releases a handle to the specified key. 
'(Key handles should not be left open any longer than
'necessary.) 
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
   ByVal hCurKey As Long) As Long
 ' RegQueryInfoKey retrieves information about the specified
'key, such as the number of subkeys and values, the length
'of the longest value and key name, and the size of the
'longest data component among the key's values. 

Private Declare Function RegQueryInfoKey _
   Lib "advapi32.dll" Alias "RegQueryInfoKeyA" ( _
   ByVal hCurKey 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 Long) As Long
  'RegEnumKeyEx enumerates subkeys of the specified open
'key. Retrieves the name (and its length) of each subkey. 
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
   Alias "RegEnumKeyExA" (ByVal hCurKey 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 Long) As Long
  'RegEnumValue enumerates the values for the specified open
  'key. Retrieves the name (and its length) of each value, 
'and the type, content and size of the data. 
Private Declare Function RegEnumValue Lib "advapi32.dll" _
   Alias "RegEnumValueA" (ByVal hCurKey As Long, _
   ByVal dwIndex As Long, ByVal lpValueName As String, _
  lpcbValueName As Long, ByVal lpReserved As Long, _
  lpType As Long, lpData As Any, lpcbData As Long) As Long
  'RegQueryValueEx retrieves the type, content and data for
' a specified value name. Note that if you declare the
' lpData parameter as String, you must pass it By Value. 
Private Declare Function RegQueryValueEx _
   Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
   ByVal hCurKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, lpType As Long, _
  lpData As Any, lpcbData As Long) As Long
  'RegSetValueEx sets the data and type of a specified
' value under a key. 
Private Declare Function RegSetValueEx Lib "advapi32.dll" _
   Alias "RegSetValueExA" (ByVal hCurKey As Long, ByVal _
  lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, lpData As Any, _
   ByVal cbData As Long) As Long
  'RegDeleteValue removes a named value from specified key. 
Private Declare Function RegDeleteValue _
   Lib "advapi32.dll" Alias "RegDeleteValueA" ( _
   ByVal hCurKey As Long, ByVal lpValueName As String) _
   As Long
  'RegDeleteKey deletes a subkey. Under Win 95/98, also
'deletes all subkeys and values. Under Windows NT/2000, 
'the subkey to be deleted must not have subkeys. The class
'attempts to use SHDeleteKey (see below) before using
'RegDeleteKey. 
Private Declare Function RegDeleteKey Lib "advapi32.dll" _
   Alias "RegDeleteKeyA" (ByVal hKey As Long, _
   ByVal lpSubKey As String) As Long
  'SHDeleteKey deletes a subkey and all its descendants. 
'Under Windows NT 4.0, Internet Explorer 4.0 or later
'is required. 
Private Declare Function SHDeleteKey Lib "Shlwapi" _
   Alias "SHDeleteKeyA" (ByVal hKey As Long, _
   ByVal lpSubKey As String) As Long
 Private Declare Function LoadLibrary Lib "Kernel32" _
   Alias "LoadLibraryA" (ByVal lpLibFileName As String) _
   As Long
  Private Declare Function FreeLibrary Lib "Kernel32" ( _
   ByVal hLibModule As Long) As Long
  Private Declare Function ExpandEnvStrings Lib "Kernel32" _
   Alias "ExpandEnvironmentStringsA" ( _
   ByVal lpSrc As String, ByVal lpDst As String, _
   ByVal nSize As Long) As Long
  Private Declare Function GetVersionEx Lib "Kernel32" _
   Alias "GetVersionExA" ( _
  lpVersionInformation As OSVERSIONINFO) As Long
  Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_DWORD = 4
Private Const REG_DWORD_LITTLE_ENDIAN = REG_DWORD
Private Const REG_MULTI_SZ = 7
  
' The following values are only relevant under WinNT/2K, 
' and are ignored by Win9x. 
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const STANDARD_RIGHTS_WRITE = &H20000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const SYNCHRONIZE = &H100000
  ' Access right to query and enumerate values. 
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
  KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _
  KEY_NOTIFY) And (Not SYNCHRONIZE)) 
'Access right to create values and keys. 
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
  KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And _
   (Not SYNCHRONIZE)) 
'Access right to create/delete values and keys. 
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
  KEY_QUERY_VALUE Or KEY_SET_VALUE Or _
  KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
  KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE)) 
  Private lRequiredAccess Private lPreviousAccess
 'Return values for all registry functions. 
Private Const ERROR_SUCCESS = 0
  'Property variables. 
Private lRoot 'default is HKEY_LOCAL_MACHINE
Private lOptions
Private strKeyName
Private strValueName
Private vData
  'Variables set in GetKeyHandle. 
Private hCurKey
Private nSubKeys
Private nValues
Private lMaxSubKeyLen
Private lMaxValueNameLen
Private lMaxValueLen
  Private bIsWinNT
  Public Enum RegOptions ' variable: lOptions
  StoreNumbersAsStrings = 1
  ReturnMultiStringsAsArrays = 2
  ExpandEnvironmentStrings = 4
  ShowErrorMessages = 8
End Enum
   Public Enum RegRoot ' variable: lRoot
  HKEY_CLASSES_ROOT = &H80000000
  HKEY_CURRENT_USER = &H80000001   ' default
  HKEY_LOCAL_MACHINE = &H80000002
End Enum
  'Message constants. 
Private Const ERROR_NO_KEY As String = _
  "No Key name specified!" 
Private Const ERROR_NO_HANDLE = _
  "Could not open Registry Key!" 
Private Const ERR_MSG_NO_OVERWRITE As String = _
  "Existing value has unsupported data type " & _
  "and will not be overwritten" 
Private Const RETURN_UNSUPPORTED As String = _
  "(unsupported data format)" 
  Private ValueList As Object
  Property Let Root(lProp As RegRoot) 
  ' Don't accept an invalid Root value. 
  Select Case lProp
    Case HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, _
          HKEY_LOCAL_MACHINE
       ' All is well. 
    Case Else
      lRoot = HKEY_CURRENT_USER
  End Select
  If lProp <> lRoot Then
    lRoot = lProp
     If Len(strKeyName) Then
      GetKeyHandle lRoot, strKeyName
     End If
  End If
  lRoot = lProp 
End Property
  Property Let Key(strProp) 
  ' Don't accept an empty key name. 
  If Len(strProp) = 0 Then Exit Property
  If Len(strKeyName) = 0 Then ' first time
    strKeyName = strProp
  ElseIf StrComp(strProp, strKeyName, _
                 vbTextCompare) <> 0 Then
    strKeyName = strProp
    GetKeyHandle lRoot, strKeyName
  Else
  End If
End Property
  Property Let Options(lProp As RegOptions) 
  ' Don't accept an invalid Options value. 
  Select Case lProp
    Case 0 To 15: lOptions = lProp
    Case Else: 
   End Select
End Property
   Property Let Value(Optional ValueName As String, vValue) 
  If IsEmpty(vValue) Then
     Exit Property
   Else
    vData = vValue
   End If
  If bIsWinNT Then lRequiredAccess = KEY_WRITE Or KEY_READ
  If PropertiesOK Then
     ' First see if this is an existing value, and, 
     ' if so, what data type we have here. 
     Dim strBuffer, lBuffer, lType
     If RegQueryValueEx(hCurKey, ValueName, 0, lType, _
        ByVal strBuffer, lBuffer) = ERROR_SUCCESS Then
       ' Make sure our new value is the same data type. 
       Select Case lType
         Case REG_SZ, REG_EXPAND_SZ ' existing string
          vData = CStr(vData) 
         Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
           ' existing long
          vData = CLng(vData) 
         Case REG_MULTI_SZ ' existing array
          vData = CVar(vData) 
         Case Else
          ShowErrMsg ERR_MSG_NO_OVERWRITE
           Exit Property
       End Select
     End If
     If (lOptions And StoreNumbersAsStrings) Then
       If IsNumeric(vData) Then vData = CStr(vData) 
     End If
     ' If nameless "(default)" value: 
     If Len(ValueName) = 0 Then vData = CStr(vData) 
     ' Look at the data type of vData, and store it
     ' in the appropriate registry format. 
     If VarType(vData) And vbArray Then   ' 8192
       Dim sTemp As String
       ' REG_MULTI_SZ values must end with 2 null characters. 
      sTemp = Join(vData, vbNullChar) & String$(2, 0) 
       Call RegSetValueEx(hCurKey, ValueName, 0, _
        REG_MULTI_SZ, ByVal sTemp, Len(sTemp)) 
     Else
       Select Case VarType(vData) 
         Case vbInteger, vbLong
           Call RegSetValueEx(hCurKey, ValueName, 0, _
            REG_DWORD, CLng(vData), 4) 
         Case vbString
           If ContainsEnvString(CStr(vData)) Then
             Call RegSetValueEx(hCurKey, ValueName, 0, _
              REG_EXPAND_SZ, ByVal CStr(vData), _
              Len(vData) + 1) 
           Else
             Call RegSetValueEx(hCurKey, ValueName, 0, _
              REG_SZ, ByVal CStr(vData), Len(vData) + 1) 
           End If
         Case Else ' Store any other data type as string. 
           Call RegSetValueEx(hCurKey, ValueName, 0, _
            REG_SZ, ByVal CStr(vData), Len(vData) + 1) 
       End Select
     End If
     ' Update Value Count. 
     Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, 0, _
       0, 0, nValues, 0, 0, 0, 0) 
     ' Clear the values database. 
    ValueList.RemoveAll
  End If
End Property
 Property Get Value(Optional ValueName As String) As Variant
  With ValueList
     If .Count = 0 Then FillDataList
     If .Exists(ValueName) Then Value = .Item(ValueName) 
  End With
End Property
  Property Get AllValues()As Variant
  If bIsWinNT Then lRequiredAccess = KEY_READ
  If PropertiesOK Then
     If nValues = 0 Then Exit Property
     With ValueList
       If .Count = 0 Then FillDataList
       If .Count Then
         Dim i, vKeys, vItems
        vKeys = .Keys
        vItems = .items
         ReDim vTemp(.Count - 1, 1) 
         For i = 0 To .Count - 1
          vTemp(i, 0) = vKeys(i) 
          vTemp(i, 1) = vItems(i) 
         Next
        AllValues = vTemp
       End If
     End With
  End If
End Property
  Property Get AllKeys()As Variant
  If bIsWinNT Then lRequiredAccess = KEY_READ
  If PropertiesOK Then
     If nSubKeys = 0 Then Exit Property
     Dim i: ReDim vTemp(nSubKeys - 1) 
     For i = 0 To nSubKeys - 1
      strKeyName = String$(lMaxSubKeyLen + 1, 0) 
       If RegEnumKeyEx(hCurKey, i, strKeyName, _
         lMaxSubKeyLen + 1, 0, vbNullString, 0, 0) = _
         ERROR_SUCCESS Then
        vTemp(i) = TrimNull(strKeyName) 
       End If
     Next
    AllKeys = vTemp
  End If
End Property
 Function DeleteValue(Optional ValueName As String) _
   As Boolean
   If bIsWinNT Then lRequiredAccess = KEY_ALL_ACCESS
  If PropertiesOK Then
    DeleteValue = (RegDeleteValue(hCurKey, ValueName) = _
      ERROR_SUCCESS) 
     If DeleteValue Then
       Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, _
        0, 0, 0, nValues, 0, 0, 0, 0) 
      ValueList.RemoveAll
     End If
  End If
End Function
  Function DeleteKey()As Boolean
  If Len(strKeyName) = 0 Then
    ShowErrMsg ERROR_NO_KEY
     Exit Function
  End If
  Dim n, strLastKey
  n = InStrRev(strKeyName, "\") 
  If n > 0 And n < Len(strKeyName) Then
    strLastKey = Mid$(strKeyName, n + 1) 
    strKeyName = Left$(strKeyName, n - 1) 
     If bIsWinNT Then lRequiredAccess = KEY_ALL_ACCESS
     Call GetKeyHandle(lRoot, strKeyName) 
     If hCurKey = 0 Then Exit Function
     If ShlwapiInstalled Then
       ' This should always work. 
      DeleteKey = (SHDeleteKey(hCurKey, strLastKey) = _
        ERROR_SUCCESS) 
     Else
       ' This will only work under Win95/98. 
      DeleteKey = (RegDeleteKey(hCurKey, strLastKey) = _
        ERROR_SUCCESS) 
     End If
     If DeleteKey Then
       Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, _
        nSubKeys, 0, 0, 0, 0, 0, 0, 0) 
      ValueList.RemoveAll
     End If
  End If
End Function
  Property Get ValueCount()As Long
  If PropertiesOK Then ValueCount = nValues
End Property
 Property Get KeyCount()As Long
  If PropertiesOK Then KeyCount = nSubKeys
End Property
  
Private Function PropertiesOK()As Boolean
  If Len(strKeyName) = 0 Then
    ShowErrMsg ERROR_NO_KEY
     Exit Function
  End If
  If lPreviousAccess Then
     If lRequiredAccess <> lPreviousAccess Then _
      CloseCurrentKey
  End If
  If hCurKey = 0 Then Call GetKeyHandle(lRoot, strKeyName) 
  If hCurKey = 0 Then 
    ShowErrMsg ERROR_NO_HANDLE
     Exit Function
  End If
  PropertiesOK = True
End Function
  Private Sub Class_Initialize()
  lRoot = HKEY_CURRENT_USER
  bIsWinNT = IsWinNT
  If bIsWinNT Then lRequiredAccess = KEY_READ
  On Error Resume Next
  Set ValueList = CreateObject("Scripting.Dictionary") 
  If IsObject(ValueList) Then
    ValueList.CompareMode = vbTextCompare
  Else
     End
  End If
End Sub
 Private Sub Class_Terminate()
  CloseCurrentKey
  Set ValueList = Nothing
End Sub
 Private Sub CloseCurrentKey()
  If hCurKey Then
     Call RegCloseKey(hCurKey) 
    hCurKey = 0
  End If
End Sub
 Private Sub GetKeyHandle(lKey, strKey) 
  CloseCurrentKey
  If lKey = 0 Then lKey = HKEY_CURRENT_USER
  Dim SA As SECURITY_ATTRIBUTES
  Call RegCreateKeyEx(lKey, strKey, 0, vbNull, 0, _
    lRequiredAccess, SA, hCurKey, 0) 
   If hCurKey Then
     Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, _
      nSubKeys, lMaxSubKeyLen, 0, nValues, _
      lMaxValueNameLen, lMaxValueLen, 0, 0) 
    ValueList.RemoveAll
    lPreviousAccess = lRequiredAccess
   End If
End Sub
 Private Function TrimNull(ByVal strIn) As String
  TrimNull = Left$(strIn, InStr(strIn, vbNullChar) - 1) 
End Function
  Private Function TrimDoubleNull(ByVal strIn) As String
  If Len(strIn) Then _
    TrimDoubleNull = _
      Left$(strIn, InStr(strIn, String$(2, 0)) - 1) 
End Function
  Private Function ExpandString(strIn) As String
  Dim nChars, strBuff, nBuffSize
  nBuffSize = 1024
  strBuff = String$(nBuffSize, 0) 
  nChars = ExpandEnvStrings(strIn, strBuff, nBuffSize) 
  If nChars Then ExpandString = Left$(strBuff, nChars - 1) 
End Function
 Private Function ShlwapiInstalled()As Boolean
  Dim hLib As Long
  hLib = LoadLibrary("Shlwapi") 
  If hLib Then
    ShlwapiInstalled = True
    FreeLibrary hLib
  End If
End Function
 Private Function ContainsEnvString(ByVal strTest) _
   As Boolean
   Const PCT As String = "%" 
  ' See if there is a percent sign. 
  Dim n As Long:
n = InStr(strTest, PCT) 
  If n = 0 Then Exit Function
  ' See if there is a second percent sign. 
  If n = InStrRev(strTest, PCT) Then Exit Function
  ' Now we have a potential environment string. 
  Dim Env As String, EnvSplit()As String
  Dim i As Long
  For i = 1 To 100
    Env = Environ(i) 
     If Len(Env) Then
      EnvSplit = Split(Env, "=") 
       If InStr(1, strTest, PCT & EnvSplit(0) & PCT, _
               vbTextCompare) Then
        ContainsEnvString = True
         Exit For
       End If
     Else
       Exit For
     End If
  Next
End Function
 Private Sub ShowErrMsg(strMsg) 
  If (lOptions And ShowErrorMessages) Then
    MsgBox strMsg, vbExclamation, "Registry Error" 
  Else
     Debug.Print strMsg
  End If
End Sub
  Private Function IsWinNT()
  ' Returns True if the OS is Windows NT/2000. 
  Const VER_PLATFORM_WIN32_NT As Long = 2
  Dim osvi As OSVERSIONINFO
  osvi.dwOSVersionInfoSize = Len(osvi) 
  GetVersionEx osvi
  IsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT) 
End Function
  Private Sub FillDataList(Optional Key As String)
  If Len(Key) Then strKeyName = Key
  If Len(strKeyName) = 0 Then _
    ShowErrMsg ERROR_NO_KEY: Exit Sub
  If bIsWinNT Then lRequiredAccess = KEY_READ
  If PropertiesOK Then
     If nValues = 0 Then Exit Sub
    ValueList.RemoveAll
     Dim i, lValuename, lType, lBuffer, strValue, strBuffer
     For i = 0 To nValues - 1
      lValuename = lMaxValueNameLen + 1
      strValue = String$(lValuename, 0) 
      lBuffer = lMaxValueLen + 1
      strBuffer = String$(lBuffer, 0) 
       If RegEnumValue(hCurKey, i, strValue, lValuename, _
         0, lType, ByVal strBuffer, lBuffer) = _
         ERROR_SUCCESS Then
        strValue = TrimNull(strValue) 
         Select Case lType
           Case REG_SZ
            ValueList(strValue) = TrimNull(strBuffer) 
           Case REG_EXPAND_SZ
             If (lOptions And ExpandEnvironmentStrings) Then
              ValueList(strValue) = _
                ExpandString(TrimNull(strBuffer)) 
             Else
              ValueList(strValue) = TrimNull(strBuffer) 
             End If
           Case REG_MULTI_SZ
             If (lOptions And _
                ReturnMultiStringsAsArrays) Then
              ValueList(strValue) = Split( _
                TrimDoubleNull(strBuffer), vbNullChar) 
             Else
              ValueList(strValue) = _
                TrimDoubleNull(strBuffer) 
             End If
           Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
             Dim nBuffer
             If RegEnumValue(hCurKey, i, strValue, _
               Len(strValue) + 1, 0, REG_DWORD, nBuffer, _
               4) = ERROR_SUCCESS Then
              ValueList(strValue) = nBuffer
             End If
           Case Else
            ValueList(strValue) = RETURN_UNSUPPORTED
         End Select
       End If
     Next
  End If

End Sub

End Listing One