Solved

Enumerating in VB6

Posted on 2011-09-30
14
282 Views
Last Modified: 2012-08-13
I have code that should go into the registry keys located in "Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList" and output the subkey along with the keys and values in each subkey.  For some reason it's not going into all the subkeys and it's not outputting the value of the keys.  What am I doing wrong?  Any help would be greatly appreciated!
Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, 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 RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey 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

Private Sub Form_Load()
    Dim hKey As Long, Cnt As Long, Cnt2 As Long, sName As String, sData As String, Ret As Long, RetData As Long
    Dim intCount As Integer, strKeyName(1 To 50) As String, strKeyTotal As String
    
    Const BUFFER_SIZE As Long = 255
    'Set the forms graphics mode to persistent
    Me.AutoRedraw = True
    Me.Print "RegEnumKeyEx"
    Ret = BUFFER_SIZE
    'Open the registry key
    If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList", hKey) = 0 Then
        'Create a buffer
        sName = Space(BUFFER_SIZE)
        'Enumerate the keys
        While RegEnumKeyEx(hKey, Cnt, sName, Ret, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> ERROR_NO_MORE_ITEMS
            'Show the enumerated key
            'Me.Print " " + Left$(sName, Ret)
            'MsgBox Cnt
            'prepare for the next key
            Cnt = Cnt + 1
            strKeyName(Cnt) = Left$(sName, Ret)
            'MsgBox strKeyName(Cnt)
            sName = Space(BUFFER_SIZE)
            Ret = BUFFER_SIZE
        Wend
        strKeyTotal = Cnt
        'MsgBox strKeyTotal
        'close the registry key
        RegCloseKey hKey
        Else
        Me.Print " Error while calling RegOpenKey"
    End If
    
    Cnt = 0
    
    intCount = 1
    For intCount = 1 To strKeyTotal
        If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\" & strKeyName(intCount), hKey) = 0 Then
            'initialize
            sName = Space(BUFFER_SIZE)
            sData = Space(BUFFER_SIZE)
            Ret = BUFFER_SIZE
            RetData = BUFFER_SIZE
            'enumerate the values
            Me.Print strKeyName(intCount)
            While RegEnumValue(hKey, Cnt2, sName, Ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
                'show data
                'If RetData > 0 Then Me.Print " " + Left$(sName, Ret) + "=" + Left$(sData, RetData - 1)
                Me.Print Left$(sName, Ret) + "=" + Left$(sData, RetData - 1)
                'prepare for next value
                Cnt2 = Cnt2 + 1
                sName = Space(BUFFER_SIZE)
                sData = Space(BUFFER_SIZE)
                Ret = BUFFER_SIZE
                RetData = BUFFER_SIZE
            Wend
            'Close the registry key
            RegCloseKey hKey
        Else
            Me.Print " Error while calling RegOpenKey"
        End If
    Next
    Me.Print vbCrLf + "RegEnumValue"
    Cnt2 = 0
End Sub

Open in new window

0
Comment
Question by:bpl5000
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 6
14 Comments
 
LVL 16

Expert Comment

by:HooKooDooKu
ID: 36893735
In VB6, the '\' is not an escape character.

Replace all your double '\\' with single '\'
0
 
LVL 13

Accepted Solution

by:
khairil earned 500 total points
ID: 36894461
Hi,

 It is still ok to have \\ in the API call as the API can understand it.

I rewrote back you apps, much more quicker for me. Just copy and paste in the form and hit F5. I hope this is one you need, just change accordingly to fit you.

Option Explicit

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 RegOpenKey Lib "advapi32.dll" _
    Alias "RegOpenKeyA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    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 RegEnumValue Lib "advapi32.dll" _
    Alias "RegEnumValueA" _
    (ByVal hKey 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
    
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 Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (lpDestination As Any, _
    lpSource As Any, _
    ByVal lNumBytes As Long)
    

Private Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Const ERROR_SUCCESS = 0&
Const ERROR_MORE_DATA = 234

Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                  KEY_QUERY_VALUE Or _
                  KEY_ENUMERATE_SUB_KEYS Or _
                  KEY_NOTIFY) And _
                  (Not SYNCHRONIZE))

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7

Private Sub Form_Load()
     Dim lngKeyHandle As Long
     Dim lngResult As Long
     Dim lngCurIdx As Long
     Dim strValue As String
     Dim lngValueLen As Long
     Dim lngData As Long
     Dim lngDataLen As Long
     Dim strResult As String
     Dim arrKey() As String
     Dim strKey As String
     Dim lngReturn As Long
     Dim lngIndex As Long
     Dim lngCount  As Long
     Dim lngValueType As Long
     Dim lngValueData As Long
     Dim strValueData As String
     Dim bytValueData() As Byte
          
     Const BUFFER_SIZE As Long = 255
     
     lngReturn = BUFFER_SIZE
     lngIndex = 0
     
     Me.AutoRedraw = True
     
     If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows NT\CurrentVersion\ProfileList", lngKeyHandle) = 0 Then
        strKey = Space(BUFFER_SIZE)
        
        While RegEnumKeyEx(lngKeyHandle, lngIndex, strKey, lngReturn, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> ERROR_NO_MORE_ITEMS
            ReDim Preserve arrKey(lngIndex + 1)
            arrKey(lngIndex) = Left$(strKey, lngReturn)
            
            Me.Print arrKey(lngIndex)
            lngReturn = BUFFER_SIZE
            lngIndex = lngIndex + 1
        Wend
        
        RegCloseKey lngKeyHandle
    Else
        MsgBox "Error opening key!"
        Exit Sub
    End If
     
    For lngCount = 0 To UBound(arrKey()) - 1
         lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                 "Software\Microsoft\Windows NT\CurrentVersion\ProfileList\" & arrKey(lngCount), _
                  0&, _
                  KEY_READ, _
                  lngKeyHandle)
    
         If lngResult <> ERROR_SUCCESS Then
             MsgBox "Cannot open key"
             Exit Sub
         End If
    
         lngCurIdx = 0
         
         Me.Print vbCrLf
         Me.Print arrKey(lngCount)
         
         Do
            lngValueLen = 2000
            lngDataLen = 2000
            
            strValue = String(lngValueLen, 0)
            ReDim bytValueData(0 To 1023) As Byte
            
            lngResult = RegEnumValue(lngKeyHandle, lngCurIdx, ByVal strValue, lngValueLen, 0&, 0&, ByVal lngData, lngDataLen)
            strValue = Left(strValue, lngValueLen)
            lngCurIdx = lngCurIdx + 1
            
            lngResult = RegQueryValueEx(lngKeyHandle, strValue, 0, lngValueType, bytValueData(0), lngDataLen)
            
            If lngResult = ERROR_SUCCESS Then
               
                Select Case lngValueType
                    Case REG_DWORD
                        CopyMemory lngValueData, bytValueData(0), 4
                        Me.Print strValue & " = " & lngValueData
                        
                    Case REG_SZ, REG_EXPAND_SZ
                        ' copy everything but the trailing null char
                        strValueData = Space$(1024)
                        CopyMemory ByVal strValueData, bytValueData(0), 1024
                        Me.Print strValue & " = " & strValueData
                        
                    Case REG_BINARY
                        ' resize the result resBinary
                        If 1024 <> UBound(bytValueData) + 1 Then
                            ReDim Preserve bytValueData(0 To 1023) As Byte
                        End If
                        Me.Print "Binary data, need special handling"  'resBinary()
                        
                    Case REG_MULTI_SZ
                        ' copy everything but the 2 trailing null chars
                        strValueData = Space$(1024)
                        CopyMemory ByVal strValueData, bytValueData(0), 1024
                        Me.Print strValue & " = " & strValueData
                        
                    Case Else
                        RegCloseKey lngKeyHandle
                        Err.Raise 1001, , "Unsupported value type"
                End Select
               
            End If
    
         Loop While lngResult = ERROR_SUCCESS
         
         Call RegCloseKey(lngKeyHandle)
    
    Next lngCount
End Sub

Open in new window

0
 
LVL 5

Author Comment

by:bpl5000
ID: 36895501
That is awesome... thanks! I do have one small problem. I'm looking for a particular string so I'm only interested in "Case REG_SZ".  When I tried this line of code...

If strValueData = "C:\Users\MyUser" Then MsgBox "Found it"

It never finds the string.  Then I discovered that if I try this...

MsgBox strValueData & "_end"

It will not append _end to the content of strValueData.  I'm thinking maybe there is something at the end of strValueData that is causing a problem?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 5

Author Comment

by:bpl5000
ID: 36896713
I setup a watch for strValueData and the value has no ending quote.  It looks like this...

"%systemroot%\system32\config\systemprofile

It has no ending quote.  How can this be fixed?  Can it be done without using CopyMemory?  Seems like every time I work with code using CopyMemory, I run into problems.  Granted it's mostly because I'm a newb (or maybe noob), but I just wonder if it could be done without CopyMemory?
0
 
LVL 5

Author Comment

by:bpl5000
ID: 36897604
Ok, I was able to get my original code to work by setting Cnt2 to 0 within the Next loop before entering the While loop.  Once I did this, it worked perfectly.

khairil, I do like your code better and would use that instead if you can figure out why the quote is missing on the end of strValueData, which should be a string.
0
 
LVL 13

Expert Comment

by:khairil
ID: 36899069
Hi pbl5000,

I did try with quoted string, and it works. The "%systemroot%\system32\config\systemprofile do not have quote in registry.

You can see the attachment, test with quote here:
 quote test
and original registry information here:
 registry information
You still can encapsulate quote around the *_SZ value from coding if you need to but please, do not mingle around with registry information. Profile section contains vital information of account exist in Windows.

Emm.. copymemory, you can still using the Left$ or Mid$ functions if you like to but you have to convert bytValueData() into string first.

1. Copymemory is API call, in most situation faster than internel VB function.

2. The second thing why Copymemory is, if you aware in first image, the is a print saying Binary data, need special handling, that is SID value which are in binary. I leave the function incomplete as I do not know what you going to do with binary data - the data is not printable.
0
 
LVL 5

Author Comment

by:bpl5000
ID: 36902940
Unfortunately you're not understanding what I'm saying.  I'm NOT trying to output anything with quotes. Here's what I am saying.  If you setup a Watch (click on Debug/Watch) for the variable strValueData, it will only show you the beginning quote, not the trailing quote.  Of course the quotes do not show in the output, but string variables ALWAYS show quotes around them in the Watch pane.

PLEASE try this at the end of the "Case REG_SZ, REG_EXPAND_SZ" block of code

Me.Print strValueData & "_end"

Notice that in your output it does NOT add _end.  Why can't I append anything to the end of this variable?
0
 
LVL 13

Expert Comment

by:khairil
ID: 36903054
Sorry pal, I got you wrong.

Both quote is actually shown, however the Value column in Watch Windows could not show it all and the cannot wrap it down. You can select the value from the Watch Windows and paste it into Notepad or Words, notice the horizontal scroll bar is you using notepad. You will get your quote there.

This is sample one of the value with both quote from Watch Windows:
quote
You can notice how long the raw string is, which why it not visible in Watch Windows. From that image too, the HEX value for so called blank is 01, space bar (visible blank) is presented by value 20. Hope this answer you. Hope this answer you.

0
 
LVL 5

Author Comment

by:bpl5000
ID: 36903085
Well that explains the trailing quote, but how can I append something at the end of this?  Did you try...

Me.Print strValueData & "_end"

The code is useless to me if I am unable to manipulate strValueData
0
 
LVL 13

Expert Comment

by:khairil
ID: 36903146
Where you want to insert that?

For Value NAME
If you plan to append BEFORE the name string "clean up" then you can insert your code BETWEEN line 158 and 159. If you plan to append AFTER the name string "clean up", then you can insert your code after line 159.

For value VALUE
If you plan to append BEFORE the value string "clean up" then you can insert your code AFTER line 162 but before line 164. If you plan to append AFTER the value string "clean up", then you can insert your code after copymemory called.  
0
 
LVL 5

Author Comment

by:bpl5000
ID: 36903955
If within the case statement (starting at line 171), I do this...

                    Case REG_SZ, REG_EXPAND_SZ
                        ' copy everything but the trailing null char
                        strValueData = Space$(1024)
                        CopyMemory ByVal strValueData, bytValueData(0), 1024
                        Me.Print strValueData & "_end"

I should get something like this for output...

%systemroot%\system32\config\systemprofile_end

But I can't append to the end of this string variable.
0
 
LVL 13

Expert Comment

by:khairil
ID: 36907735
So, exactly how do you like?

%systemroot%\system32\config\systemprofile_end

OR

%systemroot%\system32\config\systemprofile                                      
                                                                         
                                                                           s_end

OR

"%systemroot%\system32\config\systemprofile"_end
0
 
LVL 5

Author Comment

by:bpl5000
ID: 36912718
The output should look like this...

%systemroot%\system32\config\systemprofile_end

Also, if I'd like to be able to do Len(strValueData), I'd like to see if the length of the %systemroot%\system32\config\systemprofile, not 1024.
0
 
LVL 13

Expert Comment

by:khairil
ID: 36914875
Add this funciton at the end of the code:

Private Function CleanString(sInput As String) As String
    Dim lLenght As Long
    Dim lInputLenght As Long
    Dim sReturn As String
    Dim iAsciiCode As Integer
    
    lInputLenght = Len(sInput)
    
    For lLenght = 1 To lInputLenght
        iAsciiCode = Asc(Mid(sInput, lLenght, 1))
        
        If iAsciiCode >= 32 And iAsciiCode <= 126 Then
            sReturn = sReturn & Chr(iAsciiCode)
        End If
        
    Next

    CleanString = Trim(sReturn)
End Function

Open in new window


Then called this

strValueData = CleanString(strValueData)

Open in new window


after CopyMemory. You can use normal string operation on that value after that, like & or len.
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question