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.
Key name | Abbr. | Contents | Value |
HKEY_CLASSES_ROOT | HKCR | Names and properties of registered file types and information about ActiveX components. | &H80000000 |
HKEY_CURRENT_USER | HKCU | Configuration information for the user profile of the currently logged on user. | &H80000001 |
HKEY_LOCAL_MACHINE | HKLM | Configuration data for the local computer and global software settings. | &H80000002 |
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.
Data types | Used for storage of |
Constant value |
REG_SZ | A fixed-length text string. Boolean (True or False) values and other short text values usually have this data type. |
1 |
REG_EXPAND_SZ | A variable-length text string that can include variables that are resolved when an application or service uses the data. |
2 |
REG_DWORD | Data represented by a number that is 4 bytes (32 bits) long. Also suitable for Boolean (1 or 0) values. |
4 |
REG_MULTI_SZ | Multiple text strings formatted as an array of null-terminated strings, and terminated by two null characters. |
7 |
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!
Properties & Methods |
Description |
Root | Write-only property. Optional Long. Specifies the registry root containing the path specified with the Key property. Must be one of the values in FIGURE 1. If omitted, HKEY_CURRENT_USER is assumed. |
Key | Write-only property. Required string. Specifies the full path to the subkey where registry operations take place. This property must be specified before any of the other properties or methods are used. |
Value ( [ValueName]) | Read/write property. Variant. Saves or returns the data associated with ValueName under the subkey specified by the Key property. If ValueName is omitted, the default value for the key is saved or returned. |
DeleteValue ( [ValueName]) | Method. Deletes the value specified with ValueName. If ValueName is omitted, the default value for the key is deleted. When called as a function, DeleteValue returns True if the deletion was successful. |
DeleteKey | Method. Deletes the last subkey component (including all its subkeys and values) of the path specified with the Key property. When called as a function, DeleteKey returns True if the deletion was successful. |
ValueCount | Read-only property. Long. Returns the number of values under the subkey specified with the Key property. |
KeyCount | Read-only property. Long. Returns the number of subkeys under the subkey specified with the Key property. |
AllValues | Read-only property. Returns a two-dimensional Variant array of all value names and their values under the key specified with the Key property. If there are no values, AllValues returns Empty, and ValueCount returns zero. |
AllKeys | Read-only property. Returns a Variant array of all subkeys under the key specified with the Key property. If there are no subkeys, AllKeys returns Empty, and KeyCount returns zero. |
Options | Optional write-only property. Long. Lets you change the format in which values are set or returned. This property must be specified before the first Value property is set or evaluated.
• Use any combination of the following enumeration values: StoreNumbersAsStrings. Saves Integer and Long values as REG_SZ values rather than REG_DWORD values. (Note: any numeric value other than Integer or Long is always stored as a REG_SZ value.) • ReturnMultiStringsAsArrays. If the data type is REG_MULTI_SZ, the data is converted into a variant array. You can then use the VB IsArray, LBound, and UBound functions to process the array. If this value isn't set, the data is returned as a single string, in which substrings are separated by null characters. Use the VB Split function to extract individual substrings. • ExpandEnvironmentStrings. If the data type is REG_EXPAND_SZ, any substring that refers to an environment-variable (e.g. "%windir%") is replaced with its current value. • ShowErrorMessages. Displays a message box when an error occurs. If not set, errors are displayed in the Immediate window. |
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