CodeItBetter Programming Another VB Programming Blog

'System & API - How to list all installed apps
Option Explicit
 
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 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
'Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const REG_SZ = 1
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Dim RetArray() As String
 
Sub main()
    Call GetInstalledApps
    Dim I As Long
    For I = LBound(RetArray) To UBound(RetArray)
        Debug.Print RetArray(I)
    Next I
End Sub
 
Public Sub GetInstalledApps()
    Dim hParentKey As Long
    Dim hSubKey As Long
    Dim lIndex As Long
    Dim sAppID As String
    Dim lAppID As Long
    Dim sAppName As String
    Dim lAppName As Long
    Dim ValueType As Long
    Dim DummyTime As FILETIME
    Dim UbRetArray As Long
    'Dim QVErr As Long
    'Dim sErr As String
    'Dim lErr As Long

    UbRetArray = -1
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Uninstall", _
        0, KEY_ENUMERATE_SUB_KEYS, hParentKey) = 0 Then
        sAppID = Space(64)
        lAppID = 64
        Do While RegEnumKeyEx(hParentKey, lIndex, sAppID, lAppID, 0, vbNullString, 0, DummyTime) = 0
            sAppID = Left(sAppID, lAppID)
            If RegOpenKeyEx(hParentKey, sAppID, 0, KEY_QUERY_VALUE, hSubKey) = 0 Then
                lAppName = 0
                If RegQueryValueEx(hSubKey, "DisplayName", 0, ValueType, ByVal 0, lAppName) = 0 Then
                    If ValueType = REG_SZ Then
                        sAppName = Space(lAppName)
                        RegQueryValueEx hSubKey, "DisplayName", 0, 0, ByVal sAppName, lAppName
                        sAppName = Left(sAppName, lAppName - 1)
                        UbRetArray = UbRetArray + 1
                        ReDim Preserve RetArray(UbRetArray)
                        RetArray(UbRetArray) = sAppName
                    End If
                End If
                RegCloseKey hSubKey
                hSubKey = 0
            End If
            lIndex = lIndex + 1
            sAppID = Space(64)
            lAppID = 64
        Loop
        RegCloseKey hParentKey
    End If
    'GetInstalledApps = RetArray
End Sub