Hi all,
I am creating an installation for a vb project which requires that I create firstly three COM+ Applications and for each of these add a number of COM components.
Is there a way to do this during install or does anyone know of some VB to run which would do this ?
Thanks
Berni
This is a ready-only archive of the InstallSite Forum. You cannot post any new content here. / Dies ist ein Archiv des InstallSite Forums. Hier können keine neuen Beiträge veröffentlicht werden.
Creating COM+ Applications and COM Components
Started by
bernadettefearon
, Jul 02 2002 11:47
1 reply to this topic
Posted 02 July 2002 - 11:47
.................................[br]Bernadette Fearon[br]www.mineit.com
Posted 03 July 2002 - 10:12
In theory, I guess it should be possible to do this through the ComPlus table, but I've never done it. The following script will create a COM+/MTS server package on Win2K/NT. It takes the following parameters:
strAppName: The name of the application
strUsername: The username for the application to run under
strPassword: The password for the user
strDirectory: The directory where the component files are
strFileSpec: A file specification for files to add
The VBScript runs in a deferred custom action and writes messages to the UI to let the user know why it's taking so long (It's not too slow per file, but I run it with about 1500 files)
I also have scripts to delete the application, add files to an existing, etc, but I'll leave some of the fun to you.
Let me know if you run into any issues and I'll try to help next time I'm on the boards. You'll probably have to change/remove the calls to my logging routines.
strAppName: The name of the application
strUsername: The username for the application to run under
strPassword: The password for the user
strDirectory: The directory where the component files are
strFileSpec: A file specification for files to add
The VBScript runs in a deferred custom action and writes messages to the UI to let the user know why it's taking so long (It's not too slow per file, but I run it with about 1500 files)
I also have scripts to delete the application, add files to an existing, etc, but I'll leave some of the fun to you.
Let me know if you run into any issues and I'll try to help next time I'm on the boards. You'll probably have to change/remove the calls to my logging routines.
Code Sample |
Private Sub createCOMServer(strAppName, strUsername, strPassword, strDirectory, strFileSpec) On Error Resume Next Dim oMTS 'Catalog object for COM+/MTS Dim oPackages 'Package collection of the catalog Dim oPackage 'An individual package from the collection Dim oComponents 'The components collection (required for NT) Dim oUtil 'Component utility interface (required for NT) Dim oFSO 'Scripting host file system object Dim oFolder 'Folder from the file system object Dim oFile 'An individual file from the folder.files collection Dim oRecord 'Temporary MSI database record for updating the progress bar Dim oProgressRec 'Temporary MSI database record for updating the progress bar Dim strFile 'Filename of a file to be added to the app Dim intPackages 'Count of the number of packages in the packages collection Dim intReturn 'Used for trapping return values Dim i 'Counter variabled Dim bFound 'Flag if package is found to exist already Dim bTerminate 'Flag to terminate a dllhost.exe process Dim intCount 'Count of the number of dllhost.exe processes running Dim oWMI 'Windows Management and Instrumentation object Dim strQuery 'WMI query to retrieve dllhost.exe process objects. Dim oProcessArray 'Array of dllhost.exe processes Dim oProcess 'WMI process object Dim intPIDs(20) 'Array of process IDs Dim oRegExp 'Regular expression object for matching filenames Dim bMatchFiles 'Flag to determine if files must match a specified criteria Dim bNT 'Flag for operating system bNT = checkNT() If bNT Then CreateLogEntry "Creating MTS server package: " & strAppName Else CreateLogEntry "Creating COM+ server app: " & strAppName End If 'Write inital message to the progress bar Set oRecord = Session.Installer.CreateRecord(3) oRecord.StringData(1) = "CreateServer" oRecord.StringData(2) = "Creating " & strAppName & " package" oRecord.StringData(3) = "" Session.message msiMessageTypeActionStart, oRecord If Err.Number <> 0 Then 'Error with messaging. Non-fatal, clear then continue Err.Clear End If If bNT Then bTerminate = False Else Set oWMI = GetObject("winmgmts:") strQuery = "select * from win32_process " & _ "where Name=""DLLHOST.EXE""" Set oProcessArray = oWMI.execquery(strQuery) intCount = 0 For Each oProcess in oProcessArray If intCount = UBound(intPIDs) Then ReDim Preserve intPIDs(intCount + 5) End If intPIDs(intCount) = oProcess.ProcessId intCount = intCount + 1 Next bTerminate = True If Err.Number <> 0 Then 'Error with process enumeration 'Clear error, then continue with installation 'Rollback/uninstall may now call for a reboot CreateLogEntry "Error creating processID array" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.source Err.Clear 'Set flag so don't attempt to kill process at end bTerminate = False End If End If 'Create catalog object, for use throughout action If bNT Then Set oMTS = CreateObject("MTSAdmin.Catalog.1") Else Set oMTS = CreateObject("COMAdmin.COMAdminCatalog") End If If Err.Number <> 0 Then 'Need to devise a suitable system for log messages. 'Currently, display message box CreateLogEntry "Error creating catalog object." & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source Exit Sub End If 'Get the list of COM+ packages on the system If bNT Then Set oPackages = oMTS.GetCollection("Packages") Else Set oPackages = oMTS.GetCollection("Applications") End If oPackages.Populate If Err.Number <> 0 Then CreateLogEntry "Error obtaining packages collection" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source Exit Sub End If 'Initialise variables for search for existing package intPackages = oPackages.Count bFound = False 'For each COM+ package on the machine For i=0 To intPackages-1 'If Not found If bFound = False Then 'If name of old package matches name of new package If (StrComp(oPackages.Item(i).Value("Name"), strAppName) = 0) Then 'Set flag, then remove package 'Need to log this sort of information bFound = True oPackages.Remove(i) 'Save the changes oPackages.SaveChanges() End If End If Next If Err.Number <> 0 Then 'Log error removing package CreateLogEntry "Error checking for existing package" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source Exit Sub End If 'Add new package, then set the appropriate properties Set oPackage = oPackages.Add() oPackage.Value("Name") = strAppName If bNT Then oPackage.Value("Activation") = "Local" Else oPackage.Value("Activation") = 1 End If oPackage.Value("Identity") = strUsername oPackage.Value("Password") = strPassword 'Save the changes to the COM+ database oPackages.SaveChanges() If Err.Number <> 0 Then CreateLogEntry "Error creating package" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source Exit Sub End If 'Increment the progress bar by a few percent after creation of COM+ application. 'Application does not yet have components installed. To make for smoother advancing 'of the progress bar, this should be broken up into smaller pieces, one piece after 'each segment of code that has gone before Set oProgressRec = Session.Installer.CreateRecord(3) oProgressRec.IntegerData(1) = 2 oProgressRec.IntegerData(2) = 500000 oProgressRec.IntegerData(3) = 0 Session.message msiMessageTypeProgress, oProgressRec If Err.Number <> 0 Then 'Error with messaging. Non-fatal, clear error and continue Err.Clear End If If strDirectory = "" Then 'Not adding any files CreateLogEntry "No directory specified, not adding any files to package" Exit Sub End If If bNT Then Set oComponents = oPackages.GetCollection("ComponentsInPackage", oPackage.Value("ID")) Set oUtil = oComponents.GetUtilInterface End If If Err.Number <> 0 Then CreateLogEntry "Error creating component utility interface" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & _ "Error source: " & Err.Source & _ "No components have been added to the MTS package: " & strAppName Exit Sub End If 'Setup more stuff to control the progress bar. Advance in smaller increments than previous, 'with one increment per file. No ticks on the progress bar have been reserved for this 'custom action, therefore the possibility exists that the installation may try to increment 'the progress bar beyond 100%. If ticks are reserved, the progress bar will jump from 76% 'to 100% Set oProgressRec = Session.Installer.CreateRecord(3) oProgressRec.IntegerData(1) = 2 oProgressRec.IntegerData(2) = 20000 oProgressRec.IntegerData(3) = 0 If Err.Number <> 0 Then 'Error with messaging, non-fatal. Clear error and continue Err.Clear End If Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder(strDirectory) 'Loop through all files in the directory, add all type libraries to the package Set oRecord = Session.Installer.CreateRecord(3) If strFileSpec <> "" Then 'Pattern matching of filename Set oRegExp = New RegExp oRegExp.IgnoreCase = True oRegExp.Pattern = FileSpecToRegExp(strFileSpec) bMatchFiles = True Else bMatchFiles = False End If For Each oFile in oFolder.Files strFile = oFile.Path If (Not bMatchFiles Or oRegExp.Test(strFile)) Then If UCase(Right(strFile,3)) = "TLB" Then 'Setup messaging to provide messages above the progress bar, explicitly listing 'what is being done. In this case, what file is being added to the package oRecord.StringData(1) = "CreateRDAC" oRecord.StringData(2) = "Adding file " & strFile & " to " & strAppName & " package" oRecord.StringData(3) = "" Session.message msiMessageTypeActionStart, oRecord 'Update progress bar after each file Session.message msiMessageTypeProgress, oProgressRec If Err.Number <> 0 Then 'Error with messaging. Non fatal, clear then continue Err.Clear End If 'Finally add the particular component If bNT Then oUtil.InstallComponent strFile, "", "" Else oMTS.InstallComponent strAppName, strFile, "", "" End If If Err.Number <> 0 Then 'Log CreateLogEntry "Error adding item to package" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source & vbCrLf & vbCrLf & _ "Item being added was: " & strFile Err.Clear Else CreateLogEntry strFile & " successfully added to package " & strAppName End If End If End If Next 'Loop through all files in the directory, add all dll files to the package For Each oFile in oFolder.Files strFile = oFile.Path If (Not bMatchFiles Or oRegExp.Test(strFile)) Then If UCase(Right(strFile,3)) = "DLL" Then 'See comments from previous loop oRecord.StringData(1) = "CreateRDAC" oRecord.StringData(2) = "Adding file " & strFile & " to " & strAppName & " package" oRecord.StringData(3) = "" Session.message msiMessageTypeActionStart, oRecord Session.message msiMessageTypeProgress, oProgressRec If Err.Number <> 0 Then 'Clear error thrown by installer messaging components, proceed with install Err.Clear End If 'Add the component If bNT Then oUtil.InstallComponent strFile, "", "" Else oMTS.InstallComponent strAppName, strFile, "", "" End If If Err.Number <> 0 Then 'Log CreateLogEntry "Error adding item to package" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source & vbCrLf & vbCrLf & _ "Item being added was: " & strFile Err.Clear Else CreateLogEntry strFile & " successfully added to package " & strAppName End If End If End If Next If Err.Number <> 0 Then CreateLogEntry "Error occurred" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source Err.Clear End If If bTerminate Then Set oProcessArray = oWMI.execquery(strQuery) For Each oProcess in oProcessArray i = 0 bFound = False While i <= intCount And Not bFound If oProcess.ProcessId = intPIDs(i) Then bFound = True End If i = i + 1 Wend If bFound = False Then oProcess.Terminate() End If Next If Err.Number <> 0 Then 'Error terminating the process 'Clear error, then continue 'Rollback/uninstallation may now cause a reboot CreateLogEntry "Error terminating process. Uninstall may require reboot" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: " & Err.Description & vbCrLf & _ "Error source: " & Err.Source Err.Clear End If End If End Sub Private Function checkNT() On Error Resume Next Dim oShell 'Scripting host object to read the registry Set oShell = CreateObject("WScript.Shell") If oShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion") = "4.0" Then checkNT = True Else checkNT = False End If End Function Private Function FileSpecToRegExp(strFileSpec) On Error Resume Next strFileSpec = Replace(strFileSpec, ".", "\.") strFileSpec = Replace(strFileSpec, "?", ".") FileSpecToRegExp = Replace(strFileSpec, "*", ".*") End Function |