Visual Basic Registry Routines
RegEnumKeyEx: Retrieve Windows Uninstallable Application List
Posted:   Sunday July 07, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch


RegEnumKeyEx: Retrieve the Registered File Associations

This demo shows how to retrieve the listing of applications under the Uninstall key. In addition to the item names, the version (as stored in the registry with the file reference) as well as the actual uninstall string is returned. The item under the 'uninstallable' column is set True when an uninstall string is present; clicking such listview items will display the corresponding uninstall string in the textbox.
 BAS Module Code

 Form Code
Add a single command button (Command1), text box (Text1), and a listview (Listview1) to a form along with the following code:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ As Long = 1
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS As Long = 0
Private Const LB_SETTABSTOPS As Long = &H192

Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)

   RegistryName As String
   DisplayName As String
   DisplayVersion As String
   CanUninstall As Boolean
   UninstallString As String
End Type

Private Type FILETIME 'ft
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

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

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 RegQueryInfoKey Lib "advapi32.dll" _
   Alias "RegQueryInfoKeyA" _
  (ByVal hKey As Long, _
   ByVal lpClass As String, _
   lpcbClass As Long, _
   ByVal lpReserved As Long, _
   lpcSubKeys As Long, _
   lpcbMaxSubKeyLen As Long, _
   lpcbMaxClassLen As Long, _
   lpcValues As Long, _
   lpcbMaxValueNameLen As Long, _
   lpcbMaxValueLen As Long, _
   lpcbSecurityDescriptor As Long, _
   lpftLastWriteTime As FILETIME) As Long

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

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Sub Form_Load()

   With ListView1
      .ColumnHeaders.Add , , "Registry Entry"
      .ColumnHeaders.Add , , "DisplayName"
      .ColumnHeaders.Add , , "DisplayVersion"
      .ColumnHeaders.Add , , "Uninstallable"
      .View = lvwReport
      .FullRowSelect = True
      .AllowColumnReorder = True
      .LabelEdit = lvwManual
   End With
   Command1.Caption = "Get Uninstall Info"
   Text1.Text = ""
End Sub

Private Sub lvAutosizeControl(lv As ListView)

   Dim col2adjust As Long

  'Size each column based on the maximum of
  'wither the ColumnHeader text width, or,
  'if the items below it are wider, the
  'widest list item in the column
   lv.Visible = False
   For col2adjust = 0 To lv.ColumnHeaders.Count - 1
      Call SendMessage(lv.hwnd, _
                       LVM_SETCOLUMNWIDTH, _
                       col2adjust, _
                       ByVal LVSCW_AUTOSIZE_USEHEADER)

   lv.Visible = True
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

   ListView1.SortKey = ColumnHeader.Index - 1
   ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
   ListView1.Sorted = True
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)

   Text1.Text = Item.Tag
End Sub

Private Sub Command1_Click()

   Dim hKey As Long
   Dim sKey As String
   Dim dwIndex As Long
   Dim dwSubKeys As Long
   Dim dwMaxSubKeyLen As Long
   Dim ft As FILETIME
   Dim success As Long
   Dim sName As String
   Dim cbName As Long
   Dim itmx As ListItem
  'obtain a handle to the uninstall key
   sKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey)
  'if valid
   If hKey <> 0 Then
     'query registry for the number of
     'entries under that key
      If RegQueryInfoKey(hKey, _
                         0&, _
                         0&, _
                         0, _
                         dwSubKeys, _
                         dwMaxSubKeyLen&, _
                         0&, _
                         0&, _
                         0&, _
                         0&, _
                         0&, _
                         ft) = ERROR_SUCCESS Then

        'enumerate each item
         For dwIndex = 0 To dwSubKeys - 1
            sName = Space$(dwMaxSubKeyLen + 1)
            cbName = Len(sName)
            success = RegEnumKeyEx(hKey, _
                                   dwIndex, _
                                   sName, _
                                   cbName, _
                                   0, _
                                   0, _
                                   0, _
            If success = ERROR_SUCCESS Or _
               success = ERROR_MORE_DATA Then
               rapp = GetRegistryItemData(sKey, TrimNull(sName))
               Set itmx = ListView1.ListItems.Add(, , rapp.RegistryName)
               itmx.SubItems(1) = rapp.DisplayName
               itmx.SubItems(2) = rapp.DisplayVersion
               itmx.SubItems(3) = rapp.CanUninstall
               itmx.Tag = rapp.UninstallString
            End If
         Next  'For dwIndex

      End If  'If RegQueryInfoKey
      Call RegCloseKey(hKey)
   End If  'If hKey <> 0

   Call lvAutosizeControl(ListView1)

End Sub

Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function

Private Function GetRegistryItemData(ByVal sKey As String, _
                                     ByVal lpValueName As String) As REGISTRY_APPINFO

  'handle to the open subkey
   Dim hSubKey As Long     
   hSubKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey & "\" & lpValueName)
   If hSubKey <> 0 Then
      With GetRegistryItemData
         .RegistryName = lpValueName
         .DisplayName = GetRegValue(hSubKey, "DisplayName")
         .DisplayVersion = GetRegValue(hSubKey, "DisplayVersion")
         .UninstallString = GetRegValue(hSubKey, "UninstallString")
         .CanUninstall = Len(.UninstallString) > 0
      End With
      Call RegCloseKey(hSubKey)
   End If

End Function

Private Function OpenRegKey(ByVal hKey As Long, _
                            ByVal lpSubKey As String) As Long

  Dim hSubKey As Long

  If RegOpenKeyEx(hKey, _
                  lpSubKey, _
                  0, _
                  KEY_READ, _
                  hSubKey) = ERROR_SUCCESS Then

      OpenRegKey = hSubKey

  End If

End Function

Private Function GetRegValue(hSubKey As Long, sValueName As String) As String

   Dim lpValue As String   'name of the value to retrieve
   Dim lpcbData As Long    'length of the retrieved value
   Dim result As Long

  'if valid
   If hSubKey <> 0 Then
      lpValue = Space$(260)
      lpcbData = Len(lpValue)
     'find the passed value if present
      result = RegQueryValueEx(hSubKey, _
                               sValueName, _
                               0&, _
                               0&, _
                               ByVal lpValue, _
      If result = 0 Then
         GetRegValue = TrimNull(lpValue)
      End If

   End If

End Function


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter