Solved

Enumerating in VB6

Posted on 2011-09-30
14
251 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
  • 7
  • 6
14 Comments
 
LVL 16

Expert Comment

by:HooKooDooKu
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 5

Author Comment

by:bpl5000
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 13

Expert Comment

by:khairil
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

772 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now