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
Comments