Option Explicit
' Win32 API Declarations
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = (( _
STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const ERROR_SUCCESS = 0&
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
Alias "RegEnumKeyExA" (ByVal hKey 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 Any) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
' Define an enumration of the
' different registry hive types
Public Enum RegistryHives
LocalMachine = HKEY_LOCAL_MACHINE
Users = HKEY_USERS
CurrentConfig = HKEY_CURRENT_CONFIG
CurrentUser = HKEY_CURRENT_USER
ClassesRoot = HKEY_CLASSES_ROOT
End Enum
Public Function GetRegKeys( _
ByVal hive As RegistryHives, _
ByVal subKeyPath As String, _
ByRef keyList() As String) As Long
Dim lngKey As Long
Dim lngResult As Long
Dim lngSecurity As Long
Dim lngIndex As Long
Dim lngKeyNameLength As Long
Dim strKeyName As String
' Request read access to the registry key
lngSecurity = KEY_READ
' Open the key in the specified hive
lngResult = RegOpenKeyEx( _
hive, subKeyPath, 0, lngSecurity, lngKey)
' If we couldn't open the key, abort
If lngResult <> ERROR_SUCCESS Then
GetRegKeys = -1
Exit Function
End If
' Start at the first sub-key in the Key (Zero Index)
lngIndex = 0
Do
' Reset the key name variables creating a
' buffer to receive the next keys' name
lngKeyNameLength = 255
strKeyName = String(lngKeyNameLength, Chr(0))
' Ask for the next sub-key in the key
lngResult = RegEnumKeyEx(lngKey, lngIndex, _
strKeyName, lngKeyNameLength, 0, vbNullString, ByVal 0&, ByVal 0&)
' If successful, store the name in the
' array to be returned
If lngResult = ERROR_SUCCESS Then
' Strip out null characters from the buffered string
strKeyName = Trim(Replace(strKeyName, Chr(0), ""))
' Add the key name to the array
ReDim Preserve keyList(lngIndex)
keyList(lngIndex) = strKeyName
End If
' Increment the sub-key index
lngIndex = lngIndex + 1
' Keep going until there aren't any more
' sub-keys in this key
Loop While lngResult = ERROR_SUCCESS
' Close the registry key
Call RegCloseKey(lngKey)
' Return the number of sub-keys found
GetRegKeys = lngIndex - 1
End Function
Public Function GetRegKeyValue( _
ByVal hive As RegistryHives, ByVal subKeyPath As String, _
ByVal valueName As String) As String
Dim lngKey As Long
Dim lngResult As Long
Dim lngSecurity As Long
Dim lngDataLength As Long
Dim lngDataType As Long
Dim bytData() As Byte
' Request read access to the registry key
lngSecurity = KEY_READ
' Open the key in the specified hive
lngResult = RegOpenKeyEx( _
hive, subKeyPath, 0, lngSecurity, lngKey)
' If we couldn't open the key, abort
If lngResult <> ERROR_SUCCESS Then
Exit Function
End If
' Query the value name supplied to determine the
' type and size of the data it contains
lngResult = RegQueryValueEx(lngKey, _
valueName, 0, lngDataType, ByVal 0&, lngDataLength)
' If successful, the lngDataLength variable will
' contain info about the size of the buffer needed
' to correctly extract the data
If lngResult = ERROR_SUCCESS Then
' Resize the data byte-array to the necessary size
ReDim bytData(lngDataLength + 1) As Byte
' Call the same function,
' this time extracting the data contents
lngResult = RegQueryValueEx(lngKey, _
valueName, 0, lngDataType, bytData(0), lngDataLength)
If lngResult = ERROR_SUCCESS Then
' If successful, strip out terminating characters
GetRegKeyValue = Replace(StrConv(bytData, vbUnicode), Chr(0), "")
End If
End If
' Close the registry key
Call RegCloseKey(lngKey)
End Function
