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)
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

Private Type REGISTRY_APPINFO
   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)

   Next
   
   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
   Dim rapp As REGISTRY_APPINFO
   
  '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, _
                                   ft)
            
            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, _
                               lpcbData)
            
      If result = 0 Then
         GetRegValue = TrimNull(lpValue)
      End If

   End If

End Function