Link to home
Start Free TrialLog in
Avatar of yo_bee
yo_beeFlag for United States of America

asked on

How to read registry String Names under a Subkey

I am writing a very basic VB form that populates a combobox with all active computers in our Domain. Once The Computer is selected I want to purge a String from a subkey
I was able to get the string value of a certian StringName using the "GETSTRINGVALUE".
The ultimate goal it to list all the String Names under the key.



Private Sub reg_read()
        Dim oConn As ConnectionOptions = New ConnectionOptions()
        Dim scope = New ManagementScope("\\" & ComboBox1.Text & "\root\default")
        Dim registry As ManagementClass = New ManagementClass(scope, New ManagementPath("StdRegProv"), Nothing)
        Dim inParams As ManagementBaseObject = registry.GetMethodParameters("EnumValues")
        inParams("hDefKey") = 2147483650
        inParams("sSubKeyName") = "SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\"
        Dim outParams As ManagementBaseObject = registry.InvokeMethod("EnumValues", inParams, Nothing)
        ListBox1.Items.Add(outParams("sValueName"))
    End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of CSecurity
CSecurity
Flag of Iran, Islamic Republic of image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
yo_bee; I make an example for you, ...

You need a form, a comboBox (combo1), a textBox (Text1), 2 listBox (list1, list2) and a commandButton (cmd1)

and paste the next code snippet...

Option Explicit
Const REG_DWORD = 4
      Const REG_BINARY = 3
      Const REG_SZ = 1


Private Type FILETIME
    intLow As Long
    intHigh As Long
End Type

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 RegCloseKey Lib "advapi32.dll" _
          (ByVal hKey As Long) As Long

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

      Const ERROR_SUCCESS = 0&

      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))

      

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 FILETIME) As Long



Dim strBranch As Long

Private Sub Combo1_Click()
    ' Set the branch to search depending on
    ' what is selected in the ComboBox
    Select Case combo1.ListIndex
        Case 0
            strBranch = HKEY_CLASSES_ROOT
        Case 1
            strBranch = HKEY_CURRENT_USER
        Case 2
            strBranch = HKEY_LOCAL_MACHINE
        Case Else
            strBranch = HKEY_USERS
    End Select
End Sub

Private Sub listSubKeys(subclave As String)
    Dim i As Integer
    Dim lngKeyHandle As Long
    Dim lngResult As Long
    Dim lngCurIdx As Long
    Dim strValue As String
    Dim lngValueLen As Long
    Dim strClass As String
    Dim lngClassLen As Long
    Dim strResult As String
    Dim lngTime As FILETIME
    Dim strSearch As String
    Dim intSearchLen As Integer
    Dim blnMatch As Boolean
    
    i = 0
    ' Clear the current results
    List1.Clear
    ' Assign the new string to search for
    strSearch = Text1.Text
    intSearchLen = Len(strSearch)
    
    ' Open the Root Branch to search
    lngResult = RegOpenKeyEx(strBranch, _
            subclave, _
             0&, _
             KEY_READ, _
             lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        MsgBox "Cannot open key.", , "Search Registry Keys"
    Else
    ' If the Root branch can be opened, disable
    ' the buttons and begin the search
        cmd1.Enabled = False
        List1.Enabled = False
        Form1.MousePointer = 11
        
        lngCurIdx = 0
        Do
            lngValueLen = 2000
            strValue = String(lngValueLen, 0)
            lngClassLen = 2000
            strClass = String(lngClassLen, 0)
        
            ' Enumerate all the sub keys
            lngResult = RegEnumKeyEx(lngKeyHandle, _
                 lngCurIdx, _
                 ByVal strValue, _
                 lngValueLen, _
                 0&, _
                 ByVal strClass, _
                 lngClassLen, _
                 lngTime)
           
            ' Increment the index of found keys
            lngCurIdx = lngCurIdx + 1
        
            If lngResult = ERROR_SUCCESS Then
                ' Trim the current key to its actual length
                strResult = Left(strValue, lngValueLen)
                
                ' Eliminate case if the search is insensitive
                blnMatch = False
                strValue = strResult
'                If Check1.Value = 0 Then
'                    strResult = LCase(strResult)
'                    strSearch = LCase(strSearch)
'                End If
                                
                i = i + 1
                List1.AddItem strValue
            End If
        
        ' Keep looking for more keys
        Loop While lngResult = ERROR_SUCCESS
        ' Close the Root Branch
        lngResult = RegCloseKey(lngKeyHandle)
    
        ' Enable the buttons
        Form1.MousePointer = 0
        List1.Enabled = True
        cmd1.Enabled = True
        
        
        ' Display the total matches
        MsgBox "Total matches:" & Str(i), , "Search Registry Keys"
    End If
End Sub

Private Sub listKeys(subclave As String)

    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 valor As String
    
    lngResult = RegOpenKeyEx(strBranch, _
            subclave, _
             0&, _
             KEY_READ, _
             lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        MsgBox "Cannot open key"
        Exit Sub
    End If
    list2.Clear
    lngCurIdx = 0
    Do
       lngValueLen = 2000
       strValue = String(lngValueLen, 0)
       lngDataLen = 2000
    
       lngResult = RegEnumValue(lngKeyHandle, _
                                lngCurIdx, _
                                ByVal strValue, _
                                lngValueLen, _
                                0&, _
                                REG_DWORD, _
                                ByVal lngData, _
                                lngDataLen)
       lngCurIdx = lngCurIdx + 1
    
    If lngResult = ERROR_SUCCESS Then
       strResult = lngCurIdx & ": " & Left(strValue, lngValueLen)
       valor = ValorClave(subclave, Left(strValue, lngValueLen))
       list2.AddItem strResult & "(" & valor & ")"
    End If
    
    Loop While lngResult = ERROR_SUCCESS
    Call RegCloseKey(lngKeyHandle)

End Sub

Private Function ValorClave(rutaClave As String, clave As String) As String
    Dim hKey As Long
    hKey = strBranch
    ValorClave = GetString(hKey, rutaClave, clave)
    'MsgBox IIf(rutaClave <> "", "VALOR: " & vbCrLf & rutaClave, "NO HALLADO!!!")
    
End Function

Private Sub Cmd1_Click()
    If (Left(Text1.Text, 1) = "\") Then
        Text1.Text = Mid(Text1.Text, 2)
    End If
    If (Right(Text1.Text, 1) = "\") Then
        Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1)
    End If
    Call listSubKeys(Text1.Text)
End Sub

Private Sub Form_Load()
    ' Set up the Form interface
    combo1.AddItem "HKEY_CLASSES_ROOT"
    combo1.AddItem "HKEY_CURRENT_USER"
    combo1.AddItem "HKEY_LOCAL_MACHINE"
    combo1.AddItem "HKEY_USERS"
    combo1.ListIndex = 1
    combo1.TabIndex = 0
    
    Text1.Text = "SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate"
    
    cmd1.Caption = "Find SubKeys"
End Sub
        
Private Sub List1_Click()
    Call listKeys(Text1.Text & "\" & List1.List(List1.ListIndex))
End Sub

Private Sub List1_DblClick()
    Text1.Text = Text1.Text & "\" & List1.List(List1.ListIndex)
End Sub

Open in new window

You example is VB6, he need VB.NET
Avatar of yo_bee

ASKER

Sorry for the delay, but things have been  taking priority on this project.

I will give all suggestions a try when I get back from the Holiday vactions.
Someone is worthy of the 500 points.