Visual Studio Installer

Install on Demand

One very useful feature of Windows Installer is that you can install components on demand. The code below shows you how to install these features in your VB program. Many thanks to Bob Snyder for providing this.

ReadMe for InstallFeature
=========================

- How to add this code to your VB project
- Additional information
- Example
- Disclaimer
- Code


HOW TO ADD THIS CODE TO YOUR VB PROJECT
---------------------------------------

1. Create a new module, paste the code into it, and save the module.

2. At any place in your code where a certain feature is needed, call the
InstallFeature subroutine before calling the code in the feature.

3. Check the ErrMsg value returned from InstallFeature. If it is not a
zero-length string, then an error occurred and the feature was not
installed. In this case you should display the error message and NOT attempt
to call the feature's code.

4. If no ErrMsg was returned, then the feature was either installed already
or else it was successfully installed. In either case, you are now ready to
call the feature's code.


ADDITIONAL INFORMATION
----------------------

1. Each setup package (MSI database) has a Product Code to identify the
product it contains. The product code is a GUID.

2. Each feature in a setup package is identified by a Feature Name.

3. When you call InstallFeature, you have to supply the ProductCode and
FeatureName. You do not need to supply component codes. To omit them, just
pass a ComponentCount of zero.

4. Your feature's code will need to be in one or more DLL's (or EXE's).
These DLL's can be standard DLL's or they can be COM server DLL's. But in
either case, they will be dynamically linked at run-time. They cannot be
statically linked, because then they would have to be installed before your
application could start.

5. The Declare statement in Visual Basic provides a type of dynamic linking.
Your program can start and run even if one or more of the Declare'd DLL's is
missing. But you must be careful not to call any of the functions in the
missing DLL until you have installed the DLL (by calling InstallFeature).

6. The CreateObject function and the New keyword provide another type of
dynamic linking. The DLL that provides the object does not need to be
installed until you are ready to call CreateObject or New.


EXAMPLE
-------

Dim ComponentList() As String
Dim ComponentCount As Long
Dim ErrMsg As String
Dim MyObject As Object

' First call InstallFeature to make certain the feature is installed.
' If the COM Server DLL is not installed, this will cause it to be installed
and registered.

ComponentCount = 0
If Not InstallFeature(ProductCode, FeatureName, "MyFeature",
ComponentList(), ComponentCount, ErrMsg) Then
MsgBox ErrMsg
Exit Sub
End If

' Now call CreateObject to create a new instance of a class defined in the
COM server supplied by the feature.

Set MyObject = CreateObject(ProgID)
MyObject.DoSomething



DISCLAIMER
----------
This code is provided "AS IS", for illustrative purposes only, and that 
I do not warrant its suitability for any particular purpose.
Written by Bob Snyder

CODE
----------

Public Const REINSTALLMODE_REPAIR = &H1           'Reserved bit - currently ignored
Public Const REINSTALLMODE_FILEMISSING = &H2      'Reinstall only if file is missing
Public Const REINSTALLMODE_FILEOLDERVERSION = &H4 'Reinstall if file is missing, or older version
Public Const REINSTALLMODE_FILEEQUALVERSION = &H8 'Reinstall if file is missing, or equal or older version
Public Const REINSTALLMODE_FILEEXACT = &H10       'Reinstall if file is missing, or not exact version
Public Const REINSTALLMODE_FILEVERIFY = &H20      'checksum executables, reinstall if missing or corrupt
Public Const REINSTALLMODE_FILEREPLACE = &H40     'Reinstall all files, regardless of version
Public Const REINSTALLMODE_MACHINEDATA = &H80     'insure required machine registry entries
Public Const REINSTALLMODE_USERDATA = &H100       'insure required user registry entries
Public Const REINSTALLMODE_SHORTCUT = &H200       'validate shortcuts items
Public Const REINSTALLMODE_PACKAGE = &H400        'use re-cache source install package

'Functions in msi.dll
Declare Function MsiGetProductCode Lib "msi.dll" Alias "MsiGetProductCodeA" (ByVal ComponentCode As String, ByVal ProductCode As String) As Long
Declare Function MsiUseFeature Lib "msi.dll" Alias "MsiUseFeatureA" (ByVal ProductCode As String, ByVal FeatureName As String) As Long
Declare Function MsiConfigureFeature Lib "msi.dll" Alias "MsiConfigureFeatureA" (ByVal ProductCode As String, ByVal FeatureName As String, ByVal InstallState As Long) As Long
Declare Function MsiReinstallFeature Lib "msi.dll" Alias "MsiReinstallFeatureA" (ByVal ProductCode As String, ByVal FeatureName As String, ByVal ReinstallMode As Long) As Long
Declare Function MsiGetComponentPath Lib "msi.dll" Alias "MsiGetComponentPathA" (ByVal ProductCode As String, ByVal ComponentCode As String, ByVal Path As String, cbPath As Long) As Long
Declare Function MsiInstallMissingComponent Lib "msi.dll" Alias "MsiInstallMissingComponentA" (ByVal ProductCode As String, ByVal ComponentCode As String, ByVal InstallState As Long) As Long
Declare Function MsiQueryFeatureState Lib "msi.dll" Alias "MsiQueryFeatureStateA" (ByVal ProductCode As String, ByVal FeatureName As String) As Long
Declare Function MsiGetUserInfo Lib "msi.dll" Alias "MsiGetUserInfoA" (ByVal ProductCode As String, ByVal Username As String, cbUserName As Long, ByVal OrgName As String, cbOrgName As Long, ByVal SerialNo As String, cbSerialNo As Long) As Long

Function InstallFeature(ByVal ProductCode As String, ByVal FeatureName As String, ByVal FeatureDescription As String, ComponentList() As String, ByVal ComponentCount As Long, ErrMsg As String) As Boolean

  Const cReinstallMode = REINSTALLMODE_FILEOLDERVERSION
 
  Const cQueryFeatureState = 1
  Const cConfigureFeature = 2
  Const cGetComponentPath = 3
  Const cReinstallFeature = 4
 
  Dim Path As String
  Dim cbPath As Long
  Dim FeatureState As Long
  Dim ComponentState As Long
  Dim ErrCode As Long
  Dim ComponentIndex As Long
  Dim ComponentCode As String
  Dim ErrContext As Long
 
  ErrCode = MsiUseFeature(ProductCode, FeatureName)  'increment the usage count telling how many times the faeture was used
 
  FeatureState = MsiQueryFeatureState(ProductCode, FeatureName)
  Select Case FeatureState
    Case INSTALLSTATE_LOCAL
      ErrMsg = ""
    Case INSTALLSTATE_SOURCE
      ErrMsg = ""
    Case INSTALLSTATE_ABSENT
      ErrMsg = "The feature is not installed."
      ErrContext = cQueryFeatureState
    Case INSTALLSTATE_INVALIDARG
      ErrMsg = "Invalid argument."
      ErrContext = cQueryFeatureState
    Case INSTALLSTATE_UNKNOWN
      ErrMsg = "The product code or feature ID is unknown."
      ErrContext = cQueryFeatureState
    Case INSTALLSTATE_BADCONFIG
      ErrMsg = "The configuration data is corrupt."
      ErrContext = cQueryFeatureState
    Case INSTALLSTATE_ADVERTISED
      ErrCode = MsiConfigureFeature(ProductCode, FeatureName, INSTALLSTATE_LOCAL)
      Select Case ErrCode
        Case ERROR_SUCCESS
          FeatureState = INSTALLSTATE_LOCAL
          ErrMsg = ""
        Case ERROR_ALREADY_INITIALIZED
          ErrMsg = "Already initialized."
          ErrContext = cConfigureFeature
        Case ERROR_BAD_CONFIGURATION
          ErrMsg = "Bad configuration."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_ALREADY_RUNNING
          ErrMsg = "Install already running."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_FAILURE
          ErrMsg = "Install failure."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_LANGUAGE_UNSUPPORTED
          ErrMsg = "Language unsupported."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_LOG_FAILURE
          ErrMsg = "Log failure."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_PACKAGE_INVALID
          ErrMsg = "Package invalid."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_PACKAGE_OPEN_FAILED
          ErrMsg = "Package open failed."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_PACKAGE_REJECTED
          ErrMsg = "Package rejected."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_PACKAGE_VERSION
          ErrMsg = "Package version."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_PLATFORM_UNSUPPORTED
          ErrMsg = "Platform unsupported."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_REMOTE_DISALLOWED
          ErrMsg = "Remote disallowed."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_SERVICE_FAILURE
          ErrMsg = "Service failure."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_SOURCE_ABSENT
          ErrMsg = "Source absent."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_SUSPEND
          ErrMsg = "Suspend."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_TRANSFORM_FAILURE
          ErrMsg = "Transform failure."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_UI_FAILURE
          ErrMsg = "UI failure."
          ErrContext = cConfigureFeature
        Case ERROR_INSTALL_USEREXIT
          ErrMsg = "User exit."
          ErrContext = cConfigureFeature
        Case ERROR_INVALID_COMMAND_LINE
          ErrMsg = "Invalid command line."
          ErrContext = cConfigureFeature
        Case ERROR_INVALID_PARAMETER
          ErrMsg = "Invalid parameter."
          ErrContext = cConfigureFeature
        Case ERROR_PATCH_PACKAGE_INVALID
          ErrMsg = "Package invalid."
          ErrContext = cConfigureFeature
        Case ERROR_PATCH_PACKAGE_OPEN_FAILED
          ErrMsg = "Package open failed."
          ErrContext = cConfigureFeature
        Case ERROR_PATCH_PACKAGE_UNSUPPORTED
          ErrMsg = "Package unsupported."
          ErrContext = cConfigureFeature
        Case ERROR_PATCH_TARGET_NOT_FOUND
          ErrMsg = "Target not found."
          ErrContext = cConfigureFeature
        Case ERROR_UNKNOWN_PRODUCT
          ErrMsg = "Unknown product."
          ErrContext = cConfigureFeature
        Case Else
          ErrMsg = "Unknown error code."
          ErrContext = cConfigureFeature
      End Select
    Case Else
      ErrMsg = "Unknown status code."
      ErrContext = cQueryFeatureState
  End Select
 
  If (FeatureState = INSTALLSTATE_LOCAL) Or (FeatureState = INSTALLSTATE_SOURCE) Then
    ComponentIndex = 0
    ErrMsg = ""
    Do While (ComponentIndex < ComponentCount) And (Len(ErrMsg) = 0)
      ComponentCode = ComponentList(ComponentIndex)
      Path = Space$(257)
      cbPath = 257
      ComponentState = MsiGetComponentPath(ProductCode, ComponentCode, Path, cbPath)
      Path = Left$(Path, cbPath)
      Select Case ComponentState
        Case INSTALLSTATE_LOCAL    'Component is locally installed and ready to run.
          ErrMsg = ""
        Case INSTALLSTATE_SOURCE   'Component is supposed to be run from source, without installing locally.
          ErrMsg = ""
        Case INSTALLSTATE_ABSENT   'Component is missing and should be reinstalled.
          ErrCode = MsiReinstallFeature(ProductCode, FeatureName, cReinstallMode)
          Select Case ErrCode
            Case ERROR_SUCCESS
              ErrMsg = ""
            Case ERROR_INSTALL_FAILURE
              ErrMsg = "Install failure."
              ErrContext = cReinstallFeature
            Case ERROR_INVALID_PARAMETER
              ErrMsg = "Invalid parameter."
              ErrContext = cReinstallFeature
            Case ERROR_INSTALL_SERVICE_FAILURE
              ErrMsg = "Service failure."
              ErrContext = cReinstallFeature
            Case ERROR_INSTALL_SUSPEND
              ErrMsg = "Suspended."
              ErrContext = cReinstallFeature
            Case ERROR_INSTALL_USEREXIT
              ErrMsg = "User exit."
              ErrContext = cReinstallFeature
            Case ERROR_UNKNOWN_FEATURE
              ErrMsg = "Unknown feature."
              ErrContext = cReinstallFeature
            Case ERROR_UNKNOWN_PRODUCT
              ErrMsg = "Unknown product."
              ErrContext = cReinstallFeature
            Case Else
              ErrMsg = "Unknown status code."
              ErrContext = cReinstallFeature
          End Select
        Case INSTALLSTATE_NOTUSED
          ErrMsg = "Not used."
          ErrContext = cGetComponentPath
        Case INSTALLSTATE_BADCONFIG
          ErrMsg = "Bad config"
          ErrContext = cGetComponentPath
        Case INSTALLSTATE_INVALIDARG
          ErrMsg = "Invalid argument."
          ErrContext = cGetComponentPath
        Case INSTALLSTATE_SOURCEABSENT
          ErrMsg = "Source absent."
          ErrContext = cGetComponentPath
        Case INSTALLSTATE_UNKNOWN
          ErrMsg = "Unknown product."
          ErrContext = cGetComponentPath
        Case Else
          ErrMsg = "Unknown error code."
          ErrContext = cGetComponentPath
      End Select
      ComponentIndex = ComponentIndex + 1
    Loop
  End If
 
  If Len(ErrMsg) > 0 Then
    Select Case ErrContext
      Case cQueryFeatureState
        ErrMsg = "Couldn't determine the installation status of the " + FeatureDescription + "." _
        + vbCrLf + vbCrLf + "MsiQueryFeatureState returned status code " + CStr(ErrCode) + ": " + ErrMsg
      Case cConfigureFeature
        ErrMsg = "Couldn't install the " + FeatureDescription + "." _
        + vbCrLf + vbCrLf + "MsiConfigureFeature returned error code " + CStr(ErrCode) + ": " + ErrMsg
      Case cGetComponentPath
        ErrMsg = "Couldn't determine the installation status of the " + FeatureDescription + "." _
        + vbCrLf + vbCrLf + "MsiGetComponentPath returned status code " + CStr(ErrCode) + ": " + ErrMsg
      Case cReinstallFeature
        ErrMsg = "Couldn't reinstall the " + FeatureDescription + "." _
        + vbCrLf + vbCrLf + "MsiConfigureFeature returned error code " + CStr(ErrCode) + ": " + ErrMsg
    End Select
  End If
  InstallFeature = (Len(ErrMsg) = 0)

End Function


You might also like...

Comments

About the author

James Crowley

James Crowley United Kingdom

James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audien...

Interested in writing for us? Find out more.

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“The difference between theory and practice is smaller in theory than in practice.”