[Source] mEnumerateInstallerApps

Iniciado por skyweb07, 2 Febrero 2010, 13:59 PM

0 Miembros y 1 Visitante están viendo este tema.

skyweb07

Bueno esta es una pequeña función la cual nos permite obtener información detallada sobre las aplicaciones instaladas utilizando la API del Installer de Window, no es necesario leer ya las entradas del registro para obtener esta información , lo malo es que solo lista las aplicaciones que utiliza el installer , las demás las desecha porque no lo usan. También añadi otro pedazito de code para desinatalar las apliaciones con esa misma API. Bueno saludos y espero que les resulte interesante.

Option Explicit

'---------------------------------------------------------------------------------------
' Modulo         : mEnumerateInstallerApps
' Autor          : skyweb07
' Email          : skyweb09@hotmail.es
' Creación       : 02/02/2010 12:45
' Próposito      : Obtener una lista detallada de las aplicaciones instaladas en window utilizando las apis del Installer.
' Requerimientos : Windows Installer 3.0+
' Créditos       : http://msdn.microsoft.com/en-us/library/aa369426%28VS.85%29.aspx
'---------------------------------------------------------------------------------------

' // MSI

Private Declare Function MsiEnumProductsA Lib "MSI.dll" (ByVal iProductIndex As Long, ByVal lpProductBuf As String) As Long
Private Declare Function MsiGetProductInfoA Lib "MSI.dll" (ByVal szProduct As String, ByVal szAttribute As String, ByVal lpValueBuf As String, ByRef pcchValueBuf As Long) As Long
Private Declare Function MsiInstallProductA Lib "MSI.dll" (ByVal szPackagePath As String, ByVal szCommandLine As String) As Long

' // MSI Constantes

Const INSTALLPROPERTY_PRODUCTNAME = "ProductName"
Const INSTALLPROPERTY_PACKAGECODE = "PackageCode"
Const INSTALLPROPERTY_VERSIONSTRING = "VersionString"
Const INSTALLPROPERTY_HELPLINK = "HelpLink"
Const INSTALLPROPERTY_INSTALLLOCATION = "InstallLocation"
Const INSTALLPROPERTY_INSTALLSOURCE = "InstallSource"
Const INSTALLPROPERTY_INSTALLDATE = "InstallDate"
Const INSTALLPROPERTY_PUBLISHER = "Publisher"
Const INSTALLPROPERTY_LOCALPACKAGE = "LocalPackage"

Const ERROR_NO_MORE_ITEMS As Long = 259&
Const ERROR_SUCCESS As Long = 0&

Public Function EnumApplications() As Collection
   
    ' // Función para obtener el listado de aplicaciones que estan instaladas
    ' // utilizando el Installer de window, ojo que las otras aplicaciones que
    ' // no esten instaladas utilizando el Installer no las va a listar.
   
    Dim vBuffer     As String * 39
    Dim hGUID       As Collection
    Dim i           As Long
   
    Const Y As String = " - "
   
    Set hGUID = New Collection
    Set EnumApplications = New Collection
   
    Do Until MsiEnumProductsA(ByVal i, vBuffer) = ERROR_NO_MORE_ITEMS
       
        hGUID.Add Left$(vBuffer, InStr(1, vBuffer, Chr$(0)) - 1)
       
        i = i + 1
       
    Loop
   
    If hGUID.Count > 0 Then
       
        For i = 1 To hGUID.Count
           
           EnumApplications.Add ProductInfo(hGUID.Item(i), INSTALLPROPERTY_PRODUCTNAME) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_PUBLISHER) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_VERSIONSTRING) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_INSTALLDATE) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_INSTALLLOCATION) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_HELPLINK) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_LOCALPACKAGE) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_PACKAGECODE)

        Next i
       
    End If

End Function

Private Function ProductInfo(hGUID As String, hAttribute As String) As String
   
    ' // Función para obtener información acerca de una aplicación deternimada
    ' // pasandole los parámetros de la GUID de la aplicación y el atributo de
    ' // la información que se desea obtener.
   
    Dim vBuffer As String * 260
       
    If MsiGetProductInfoA(hGUID, hAttribute, vBuffer, Len(vBuffer)) = ERROR_SUCCESS Then
       
        ProductInfo = Left$(vBuffer, InStr(1, vBuffer, Chr$(0)) - 1)
       
    End If
   
End Function

Public Function Uninstall(hPath As String) As Long
   
    ' // Función para desinstalar un programa utilizando el installer
    ' // ojo que el valor lo devuelve solo cuando se desinstala el programa
    ' // o cuando el usuario cancela la instalación
    ' // Más información aqui : http://msdn.microsoft.com/en-us/library/aa370315%28VS.85%29.aspx
   
    Uninstall = MsiInstallProductA(hPath, "REMOVE=ALL")

End Function

cobein

Nada mal pero, lamentablemente mustra unas pocas apps, en mi caso 2 contra ccleaner que tiene 15.
Mira que MsiEnumProducts es vieja, hay una nueva funcion llamada MsiEnumProductsEx pero no es soportada por todas las versiones de MSI obviamente.
http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.

skyweb07

Realmente el problema es que hay algunas aplicaciones que no utilizan el Installer para instalarse por lo que al instalars no añaden los registros al installer, entonces el installer solo tiene los registros de los que lo usan, este ejemplo solo funciona con las aplicaciones que el installer ha registrado, hay otra forma enumernndo todas las aplicaciones desde el registro las cuales estan en esta key :

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall

Dentro de 5 minutos pongo un ejemplo de como listar esas de ahi ;) Saludos.

skyweb07

#3
Bueno aqui esta el otro ejemplo utilizando el registro. Lo hize un poco rápido asi que puede que tenga algún error o algo.... Saludos.

Option Explicit

'---------------------------------------------------------------------------------------
' Modulo         : mEnumerateRegistryApps
' Autor          : skyweb07
' Email          : skyweb09@hotmail.es
' Creación       : 02/02/2010 14:35
' Próposito      : Obtener una lista detallada de las aplicaciones instaladas en window utilizando las entradas del registro.
' Requerimientos : Ninguno.
'---------------------------------------------------------------------------------------

' // Entradas del registro

Enum hKeys
   HKEY_CLASSES_ROOT = &H80000000
   HKEY_CURRENT_CONFIG = &H80000005
   HKEY_CURRENT_USER = &H80000001
   HKEY_LOCAL_MACHINE = &H80000002
   HKEY_USERS = &H80000003
End Enum

' // Estructura que no vamos a utilizar pero necesaria [Si la utilizaramos devolveria los valores de los datos de la edición del registro.]

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

' // Apis para el manejo del registro.

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Any, ByRef lpcbData 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, ByRef lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, ByRef lpcbClass As Long, ByRef lpftLastWriteTime As FILETIME) As Long

' // Constantes del registro.

Private Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Private Const KEY_CREATE_LINK As Long = &H20
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_NOTIFY As Long = &H10
Private Const KEY_SET_VALUE As Long = &H2
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 KEY_EXECUTE As Long = (KEY_READ)
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const KEY_WRITE As Long = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const KEY_ALL_ACCESS As Long = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_DWORD_BIG_ENDIAN As Long = 5
Private Const REG_DWORD_LITTLE_ENDIAN As Long = 4
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_LINK As Long = 6
Private Const REG_MULTI_SZ As Long = 7
Private Const REG_NONE As Long = 0
Private Const REG_QWORD As Long = 11
Private Const REG_QWORD_LITTLE_ENDIAN As Long = 11
Private Const REG_SZ As Long = 1
Private Const REG_ALL = (REG_BINARY Or REG_DWORD Or REG_DWORD_BIG_ENDIAN Or REG_DWORD_LITTLE_ENDIAN Or REG_DWORD_LITTLE_ENDIAN Or REG_EXPAND_SZ Or REG_LINK Or REG_MULTI_SZ Or REG_NONE Or REG_QWORD Or REG_QWORD_LITTLE_ENDIAN Or REG_SZ)

Private Const ERROR_NO_MORE_ITEMS As Long = 259&
Private Const ERROR_SUCCESS As Long = 0&

Public Function EnumApplications() As Collection
   
   Dim vKeys() As String
   Dim i       As Long
   
   Set EnumApplications = New Collection
   
   Const Y As String = " - "
   
   If EnumKeys(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", vKeys()) Then
       
       For i = 0 To UBound(vKeys)
           
           EnumApplications.Add ProductInfo(vKeys(i), "DisplayName") & Y & ProductInfo(vKeys(i), "Publisher") & Y & ProductInfo(vKeys(i), "DisplayVersion") & Y & Format$(ProductInfo(vKeys(i), "InstallDate"), "####/##/##") & Y & ProductInfo(vKeys(i), "InstallSource") & Y & ProductInfo(vKeys(i), "URLInfoAbout")

       Next i
       
   End If
   
End Function

Private Function ProductInfo(hEntry As String, hAttribute As String) As String
   
  ProductInfo = ReadKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & hEntry, hAttribute)

End Function

Private Function EnumKeys(hKey As hKeys, hSubKey As String, hReturn() As String) As Long

   Dim vBuffer     As String * 260
   Dim vReturn     As Long
   Dim vIndex      As Long
   Dim FT          As FILETIME

   If RegOpenKeyEx(hKey, hSubKey, ByVal 0&, KEY_ALL_ACCESS, vReturn) = ERROR_SUCCESS Then
       
       Do Until RegEnumKeyEx(vReturn, vIndex, vBuffer, Len(vBuffer), ByVal 0&, vbNullString, ByVal 0&, FT) = ERROR_NO_MORE_ITEMS
           
           ReDim Preserve hReturn(0 To vIndex)
           
           hReturn(vIndex) = Left$(vBuffer, InStr(1, vBuffer, Chr$(0)) - 1)
           
           vIndex = vIndex + 1: EnumKeys = EnumKeys + 1
           
       Loop
       
   End If
   
End Function

Private Function ReadKey(hKey As hKeys, hSubKey As String, hValue As String) As String
   
   Dim hReturn     As Long
   Dim hResult     As Long
   Dim hData       As Long
   Dim hFinal      As String
   
   If RegOpenKeyEx(hKey, hSubKey, ByVal 0&, KEY_ALL_ACCESS, hReturn) = ERROR_SUCCESS Then
           
       hResult = RegQueryValueEx(hReturn, hValue, 0, REG_ALL, ByVal 0&, hData)
       
       hFinal = String$(hData, Chr$(0))
       
       If RegQueryValueEx(hReturn, hValue, 0, REG_ALL, ByVal hFinal, hData) = ERROR_SUCCESS Then
           
           ReadKey = Left$(hFinal, InStr(1, hFinal, Chr$(0)) - 1)
       
       End If
       
   End If
   
   If hReturn <> 0 Then
       
       Call RegCloseKey(hReturn)
       
   End If
   
End Function

cobein

Este me gusta mas, tiene algunos detalles pero funciona mejor. Buen trabajo.
http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.

seba123neo

La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson