S
Steve James
Hello All
I am trying to use the Baarns Developer Jump Start workbook for a
project, but I'm having trouble debugging one of the example functions
in the workbook. The following code bombs at the call to
RegEnumKeyExA, which is returning error code 234 (or ERROR_MORE_DATA).
According to
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/regenumkeyex.asp,
this is due to the lpName buffer being too small. However, my
understanding is that for Nt4.0 (my platform), key names are up to 255
characters. The code below seems to be consistent with this.
Am I missing something?
Regards
Steve
=====================================================================
Public Const ERROR_SUCCESS As Long = 0
Public Const ERROR_NO_MORE_ITEMS As Long = 259
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Public Const KEY_QUERY_VALUE As Long = &H1
Public Const KEY_SET_VALUE As Long = &H2
Public Const KEY_CREATE_SUB_KEY As Long = &H4
Public Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Public Const KEY_NOTIFY As Long = &H10
Public Const SYNCHRONIZE As Long = &H100000
Public Const KEY_CREATE_LINK As Long = &H20
Public Const KEY_ALL_ACCESS As Long = ((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))
Public Const ROOT_KEY_NAME As String = _
"Software\Microsoft\Office\8.0\Excel"
Const mlBASIC_SETTING_LENGTH As Long = 256
Type FILETIME ''' Used by RegListKeysTest sub.
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type SECURITY_ATTRIBUTES ''' Used by RegOpenKey function.
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Declare Function RegCreateKeyExA Lib "advapi32.dll" _
(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
Declare Function RegEnumKeyExA Lib "advapi32.dll" _
(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 FILETIME) As Long
Sub RegListKeysTest()
''' API Function Variables
Dim szKeyName As String ''' Buffer to hold returned key name
Dim szClass As String ''' Class name to use for the key
Dim lLenKeyName As Long ''' Length of the szKeyName buffer
Dim lReserved As Long ''' Placeholder
Dim lClassLen As Long ''' The length of the szClass buffer
Dim uFileTime As FILETIME ''' File structure for last mod time
''' Procedure Variables
Dim szTrimmedValName As String ''' Name of trimmed current key
Dim lHandle As Long ''' The handle to the key being opened
Dim lResult As Long ''' Return value from the API function
Dim lCount As Long ''' Index of key being enumerated
Dim lRoot As Long
Dim szRootKey As String
Dim aszList() As String ''' Array containing list of sub-keys
'' parameters
lRoot = HKEY_CURRENT_USER
szRootKey = "Software\Microsoft\Office\8.0\Excel"
''' Open the key.
bRegOpenKey lHandle, lRoot, szRootKey
''' Init Index
lCount = 0
''' Enumerate the values.
Do
''' Set RegEnumValueA variables.
szKeyName = String$(mlBASIC_SETTING_LENGTH, vbNullChar)
lLenKeyName = mlBASIC_SETTING_LENGTH - 1
lReserved = 0
szClass = ""
lClassLen = 0
''' Enumerate the value.
lResult = RegEnumKeyExA(lHandle, lCount, szKeyName, _
lLenKeyName, lReserved, _
szClass, lClassLen, uFileTime)
If lResult = ERROR_SUCCESS Then
''' Trim out the name of the value.
szTrimmedValName = Left$(szKeyName, lLenKeyName)
ReDim Preserve aszList(0 To lCount)
aszList(lCount) = szTrimmedValName
lCount = lCount + 1
End If
Loop Until lResult <> ERROR_SUCCESS
If lResult <> ERROR_NO_MORE_ITEMS Then
MsgBox "RegNumKeyExA returned error value " & lResult
Else
If lCount = 0 Then
MsgBox "No keys"
End If
End If
''' Close the Key
bRegCloseKey lRoot
End Sub
Function bRegOpenKey(Optional lHandle As Long, _
Optional lRoot As Long = HKEY_CURRENT_USER, _
Optional szKeyName As String = ROOT_KEY_NAME, _
Optional lAccessType As Long = KEY_ALL_ACCESS) _
As Boolean
Dim lResult As Long ''' Return value from the API function
Dim lReserved As Long ''' Placeholder
Dim szClass As String
Dim lOptions As Long
Dim uSecurity As SECURITY_ATTRIBUTES
Dim lDisposition As Long ''' Indicates if created or opened
lReserved = 0
lResult = ERROR_SUCCESS
szClass = ""
lOptions = 0
lDisposition = 0
lResult = RegCreateKeyExA(lRoot, szKeyName, lReserved, szClass, _
lOptions, lAccessType, uSecurity, _
lHandle, lDisposition)
If lResult <> ERROR_SUCCESS Then
MsgBox "RegCreateKeyExA() returned " & lResult
bRegOpenKey = False
Exit Function
End If
bRegOpenKey = True
Exit Function
End Function
Function bRegCloseKey(Optional lRoot As Long = HKEY_CURRENT_USER) _
As Boolean
Dim lResult As Long ''' Return value from the API function.
On Error Resume Next
lResult = ERROR_SUCCESS
lResult = RegCloseKey(lRoot)
If lResult = ERROR_SUCCESS Then
bRegCloseKey = True
Else
MsgBox "RegCloseKey() returned " & lResult
bRegCloseKey = False
End If
End Function
I am trying to use the Baarns Developer Jump Start workbook for a
project, but I'm having trouble debugging one of the example functions
in the workbook. The following code bombs at the call to
RegEnumKeyExA, which is returning error code 234 (or ERROR_MORE_DATA).
According to
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/regenumkeyex.asp,
this is due to the lpName buffer being too small. However, my
understanding is that for Nt4.0 (my platform), key names are up to 255
characters. The code below seems to be consistent with this.
Am I missing something?
Regards
Steve
=====================================================================
Public Const ERROR_SUCCESS As Long = 0
Public Const ERROR_NO_MORE_ITEMS As Long = 259
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Public Const KEY_QUERY_VALUE As Long = &H1
Public Const KEY_SET_VALUE As Long = &H2
Public Const KEY_CREATE_SUB_KEY As Long = &H4
Public Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Public Const KEY_NOTIFY As Long = &H10
Public Const SYNCHRONIZE As Long = &H100000
Public Const KEY_CREATE_LINK As Long = &H20
Public Const KEY_ALL_ACCESS As Long = ((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))
Public Const ROOT_KEY_NAME As String = _
"Software\Microsoft\Office\8.0\Excel"
Const mlBASIC_SETTING_LENGTH As Long = 256
Type FILETIME ''' Used by RegListKeysTest sub.
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type SECURITY_ATTRIBUTES ''' Used by RegOpenKey function.
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Declare Function RegCreateKeyExA Lib "advapi32.dll" _
(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
Declare Function RegEnumKeyExA Lib "advapi32.dll" _
(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 FILETIME) As Long
Sub RegListKeysTest()
''' API Function Variables
Dim szKeyName As String ''' Buffer to hold returned key name
Dim szClass As String ''' Class name to use for the key
Dim lLenKeyName As Long ''' Length of the szKeyName buffer
Dim lReserved As Long ''' Placeholder
Dim lClassLen As Long ''' The length of the szClass buffer
Dim uFileTime As FILETIME ''' File structure for last mod time
''' Procedure Variables
Dim szTrimmedValName As String ''' Name of trimmed current key
Dim lHandle As Long ''' The handle to the key being opened
Dim lResult As Long ''' Return value from the API function
Dim lCount As Long ''' Index of key being enumerated
Dim lRoot As Long
Dim szRootKey As String
Dim aszList() As String ''' Array containing list of sub-keys
'' parameters
lRoot = HKEY_CURRENT_USER
szRootKey = "Software\Microsoft\Office\8.0\Excel"
''' Open the key.
bRegOpenKey lHandle, lRoot, szRootKey
''' Init Index
lCount = 0
''' Enumerate the values.
Do
''' Set RegEnumValueA variables.
szKeyName = String$(mlBASIC_SETTING_LENGTH, vbNullChar)
lLenKeyName = mlBASIC_SETTING_LENGTH - 1
lReserved = 0
szClass = ""
lClassLen = 0
''' Enumerate the value.
lResult = RegEnumKeyExA(lHandle, lCount, szKeyName, _
lLenKeyName, lReserved, _
szClass, lClassLen, uFileTime)
If lResult = ERROR_SUCCESS Then
''' Trim out the name of the value.
szTrimmedValName = Left$(szKeyName, lLenKeyName)
ReDim Preserve aszList(0 To lCount)
aszList(lCount) = szTrimmedValName
lCount = lCount + 1
End If
Loop Until lResult <> ERROR_SUCCESS
If lResult <> ERROR_NO_MORE_ITEMS Then
MsgBox "RegNumKeyExA returned error value " & lResult
Else
If lCount = 0 Then
MsgBox "No keys"
End If
End If
''' Close the Key
bRegCloseKey lRoot
End Sub
Function bRegOpenKey(Optional lHandle As Long, _
Optional lRoot As Long = HKEY_CURRENT_USER, _
Optional szKeyName As String = ROOT_KEY_NAME, _
Optional lAccessType As Long = KEY_ALL_ACCESS) _
As Boolean
Dim lResult As Long ''' Return value from the API function
Dim lReserved As Long ''' Placeholder
Dim szClass As String
Dim lOptions As Long
Dim uSecurity As SECURITY_ATTRIBUTES
Dim lDisposition As Long ''' Indicates if created or opened
lReserved = 0
lResult = ERROR_SUCCESS
szClass = ""
lOptions = 0
lDisposition = 0
lResult = RegCreateKeyExA(lRoot, szKeyName, lReserved, szClass, _
lOptions, lAccessType, uSecurity, _
lHandle, lDisposition)
If lResult <> ERROR_SUCCESS Then
MsgBox "RegCreateKeyExA() returned " & lResult
bRegOpenKey = False
Exit Function
End If
bRegOpenKey = True
Exit Function
End Function
Function bRegCloseKey(Optional lRoot As Long = HKEY_CURRENT_USER) _
As Boolean
Dim lResult As Long ''' Return value from the API function.
On Error Resume Next
lResult = ERROR_SUCCESS
lResult = RegCloseKey(lRoot)
If lResult = ERROR_SUCCESS Then
bRegCloseKey = True
Else
MsgBox "RegCloseKey() returned " & lResult
bRegCloseKey = False
End If
End Function