This is some code to list all installed apps

[Tygur]

I just made some code for someone that lists all installed apps. I just decided to throw it in here for anyone who might be interested in using it.

It's a function, called GetInstalledApps, which returns an array with the names of all the installed apps. It should be easy enough to figure out how to use.

The code is based on information gathered from the MSDN Library. It has lots of information for people who want to make their own installers.

Here's the code:

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
 
Function GetInstalledApps() As String()
Dim RetArray() As String
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 Function

Have fun