用VB實現COM+組件配置

肖志云

在Windwos2000的管理工具里有一個“組件服務”工具，可以實現對COM+組件的應用的安裝、啟動、刪除和對組件的安裝、刪除。這在安裝一個有COM+組件的應用系統時時非常有用的，我們可以通過程序控制一個組件添加刪除，可以通過程序實現這個過程的自動化，而不必人工停止應用再安裝組件！
現在我們來討論怎樣用VB程序實現這個工具的這些功能。
一、COMAdmin接口簡介
COMAdmin接口是實現這些功能的關鍵對象，它有有三個基本接口,分別是IcomAdminCatalog,IcatalogCollection,IcatalogObject,調用這三個接口的相關屬性方法可以實現對COM組件的添加、刪除、應用的添加、刪除、啟動、關閉等功能。
1、IcomadminCatalog接口介紹
IcomAdminCatalog接口代表COM+ Catalog本身。
方法：GetCollection可以取得COM+ Catalog中包含的集合。
2、IcatalogCollection接口介紹
IcatalogCollection接口可以枚舉內容、讀取、增加、刪除集合項目。
方法：Populate讓集合填入內容；
方法：PopulateBykey同Populate,但讓集合從akeys指定項讀取數值；
方法：remove刪除一個對象，參數是對象在集合中的索引；
方法：SaveChanges保存對屬性的改變，無參數，返回保存的改變次數。
3、IcatalogObject接口介紹
屬性：Name:包含目錄對象的只讀屬性；
屬性：Key:包含目錄對象的唯一項的只讀屬性，這個屬性用于需要對象項的方法，如PopulateByKeys ；
屬性：Valid:表示對象是否有效的只讀屬性；
屬性：Value包含對象所支持的任何命名屬性值的讀/寫屬性，每個目錄對象支持的一組命名屬性。
二、程序設計思路
建立對應用和組件的控制函數，在應用列表框中列表出本機上的應用名，在屬性列表框顯示所選擇應用中包含的組件，通過工具條按鈕事件實現對所選擇的應用或組件的添加、刪除、啟動、關閉的功能。
要實現這些功能，我們計劃有如下幾個函數：
1． Createocatalog 創建取得應用集合的COMAdminCatalogCollection 對象；
2． Addapp 創建應用函數；
3． Deleteapp 刪除應用函數；
4． Startobject 啟動一個應用函數；
5． Stopobject 停止應用函數；
6． Addcomponent 在一個應用中添加一個組件；
7． Deletecomponent 在一個應用中刪除一個組件；
8． Displayobjects 在應用列表框中顯示應用名；
9． Disaplaycomponent 在應用組件列表框中顯示所選則的應用中的組件名。
三、VB程序的實現
1、主界面的設計


(圖一)

如圖一，將應用名列表放在左邊的列表框lbobject內，選擇一個應用，則在右邊列出這個應用中的COM組件名。當我們選擇一個應用或組件時，可以選擇工具條上相關的操作對應用或COM+組件進行控制。
2、程序實現步驟
首先在定義變量如下
Option Explicit
Public ocatalog As COMAdminCatalog
Public ocatcol As COMAdminCatalogCollection
Public ocatobj As COMAdminCatalogObject
然后我們定義一個函數實現取得COM+應用的集合.
Private Function createocatalog() As Boolean
createocatalog = False
'創建catalog對象
Set ocatalog = New COMAdminCatalog
'得到應用連接
Set ocatcol = ocatalog.GetCollection("Applications")
createocatalog = True
End Function
接下來我們在Form的啟動事件里寫上如下代碼：
Private Sub Form_Load()
If App.PrevInstance Then
Unload Me
MsgBox "程序已經運行！"
Exit Sub
End If
form1.Show
If createocatalog() Then
StatusBar1.Panels(2) = "連接COMADMIN成功"
displayobjects ocatcol
Else
StatusBar1.Panels(2) = "連接COMADMIN失敗!"
MsgBox "連接失敗，請確認系統是否安裝的組件服務！"
End If
End Sub
到這里我們實現了對組件應用對象的連接，接下來就是對這些對象的操作。我們先定義這樣一些函數：
Public Function addapp(Optional name As String = "NewAppliation", Optional activation As Integer = 1, Optional Identity As String = "Interactive User") As String
'添加一個應用
On Error GoTo errd
Set ocatobj = ocatcol.Add '添加一個新應用
ocatobj.Value("Name") = name '設置這個應用的屬性
ocatobj.Value("Activation") = activation
ocatobj.Value("Identity") = Identity
ocatcol.SaveChanges '保存關于ocatcol對象的改變
addapp = "OK"
Exit Function
errd:
addapp = Err.Description '如果出錯返回錯誤信息
End Function
（addapp函數實現添加一個組件應用,參數name是要為這個新應用確定一個名字，我們可以默認是NewApplication,Activation和Indentity分別是配置這個應用的相關屬性）
Public Function deleteapp(name As String) As String '參數name是應用的PROGID
If name <> "" Then
Dim oo As Object
Dim i As Integer
i = 0
On Error GoTo errd
ocatcol.Populate '首次取得目錄集合時，缺省為空，需要調用Populate來填入內容
For Each oo In ocatcol
If oo.name = name Then
ocatcol.Remove i '刪除索引號為i的組件應用
ocatcol.SaveChanges '保存
End If
i = i + 1
Next
End If
deleteapp = "ok"
Exit Function
errd:
addapp = Err.Description
End Function
（函數deleteapp實現刪除名字為name的一個組件應用。）
Public Function startobject(name As String) As String '參數name是應用的PROGID
Dim oo As Object
On error goto errd
ocatcol.Populate
For Each oo In ocatcol
If oo.name = name Then
ocatalog.StartApplication oo.Key '啟動一個應用
End If
Next
startobject = "OK"
Exit function
errd: '錯誤處理
startobject = Err.Description
End Function
（函數startobject實現啟動名字為name的一個組件應用。）
Public Function stopobject(name As String) As String
Dim oo As Object
On error goto errd
ocatcol.Populate
For Each oo In ocatcol
If oo.name = name Then
ocatalog.ShutdownApplication oo.Key '停止這個應用
End If
Next
Stopobject = "OK"
Exit funcition
Errd:
Stopobject = Err.Description.
End Function
（Stopobject函數實現停止一個應用）
到這里我們已經實現了對應用的控制，下面我們來實現對組件的控制。
Public Function addcomponent(name As String, filename As String) As String
Dim oo As Object
On error goto errd
For Each oo In ocatcol
If oo.name = name Then
ocatalog.InstallComponent name, filename, "", "" '在這里實現安裝組件到一個應用
End If
addcomponent = "OK"
exit function
Next
Errd:
addcomponent = err. Description
End Function
（addcomponent實現在一個應用里安裝一個新的組件，參數name是應用名(PROGID),filename是組件文件(即.DLL文件)的完整路徑）
Public Function deletecomponent(name As String, componentname As String) As String
Dim oo As Object
Dim okey As Variant
Dim components As Object
Dim i As Integer
On error goto errd
ocatcol.Populate
For Each oo In ocatcol
If oo.name = name Then
okey = oo.Key
End If
Next
Set components = ocatcol.GetCollection("Components", okey)
components.Populate
If components.Count > 0 Then
i = 0
For Each oo In components
If oo.name = componentname Then
components.Remove i
components.SaveChanges
End If
i = i + 1
Next
Deletecomponent = "OK"
Exit function
Else
Deletecomponent = "當前選擇應用中沒有組件！"
End If
Errd:
Deletecomponent = err. Description
End Function
（Deletecomponent實現在一個應用里刪除一個組件，參數name是應用名(PROGID), componentname是組件名(即組件的PROGID)）
到這里，我們已經可以調用這些函數實現對組件的控制了，下面我們就來看看怎么樣調用這些函數實現對組件的完全控制。
首先我們還需要添加兩個過程：
Public Sub displayobjects(CurrentConnection As COMAdminCatalogCollection)
Dim oo As Object
CurrentConnection.Populate
With lbobject
.Clear
For Each oo In CurrentConnection
.AddItem oo.name '我們將取得的對象集合的的應用名添加到對象列表框中去
Next
End With
End Sub
（displayobjects過程實現將傳入的集合顯示在應用列表框中去）
Public Function disaplaycomponent(name As String, CurrentConnection As _
COMAdminCatalogCollection) 'name是應用名，CurrentConnection是已經取得應用對象的集合
Dim oo As Object
Dim okey As Variant
Dim components As Object
CurrentConnection.Populate
For Each oo In CurrentConnection
If oo.name = name Then
okey = oo.Key '取得CurrentConnection集合中名為name的應用的CLSID
End If
Next
Set components = CurrentConnection.GetCollection("Components", okey)
components.Populate
With lbcomponent
.Clear
For Each oo In components
.AddItem oo.name '將組件名添加進組件列表框中
Next
End With
End Function
（displayobjects過程實現將傳入的應用的組件顯示在組件列表框中）
好，有了這些函數過程，我們就能調用他們實現對應用、組件的顯示和控制了。
下面的代碼是調用這些函數的例子。
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case Is = 1 '刷新列表
displayobjects ocatcol
StatusBar1.Panels(1) = "刷新列表:"
StatusBar1.Panels(2) = "刷新列表成功！"
Case Is = 2 '添加應用
form2.Show vbModal, Me
StatusBar1.Panels(1) = "添加應用："
StatusBar1.Panels(2) = "添加應用成功！"
Case Is = 3 '刪除應用
If lbobject.Text <> "" Then
deleteapp lbobject.Text
displayobjects ocatcol
StatusBar1.Panels(1) = "刪除應用："
StatusBar1.Panels(2) = "刪除應用成功！"
Else
MsgBox "請選擇一個應用！"
End If
Case Is = 4 '啟動當前應用
If lbobject.Text <> "" Then
StatusBar1.Panels(1) = "啟動當前應用："
StatusBar1.Panels(2) = "正在啟動當前應用．．．"
startobject lbobject.Text
StatusBar1.Panels(2) = "啟動當前應用成功！"
Else
MsgBox "請選擇一個應用！"
End If
Case Is = 5 '停止應用
If lbobject.Text <> "" Then
StatusBar1.Panels(1) = "停止當前應用："
StatusBar1.Panels(2) = "正在關閉當前應用．．．"
stopobject lbobject.Text
StatusBar1.Panels(2) = "正在關閉當前應用成功！"
Else
MsgBox "請選擇一個應用！"
End If
Case Is = 6 '安裝組件
If lbobject.Text <> "" Then
On Error GoTo errhandler
CommonDialog1.Filter = "組件文件 (*.dll) | *.dll"
CommonDialog1.ShowOpen
Dim filename As String
filename = Trim$(CommonDialog1.filename)
StatusBar1.Panels(1) = "安裝組件："
StatusBar1.Panels(2) = "正在將組件安裝進當前應用．．．"
addcomponent lbobject.Text, filename
StatusBar1.Panels(2) = "組件安裝成功！"
disaplaycomponent lbobject.Text, ocatcol
Exit Sub
Else
MsgBox "請選擇一個應用，再安裝組件！"
End If
errhandler:
'按了cancel按鈕
Exit Sub
Case Is = 7 '刪除組件
If lbobject.Text = "" Then
MsgBox "請選擇一個應用！"
Exit Sub
End If
If lbcomponent.Text = "" Then
MsgBox "請選擇一個組件！"
Exit Sub
End If
deletecomponent lbobject.Text, lbcomponent.Text
StatusBar1.Panels(1) = "刪除組件："
StatusBar1.Panels(2) = "刪除組件成功！"
disaplaycomponent lbobject.Text, ocatcol
Case Is = 8 '關于程序
MsgBox "這個程序是COM組件的控制的程序,VB6.0開發，在win2000下調試通過！歡迎指教！"
End Select
End Sub
到這里程序完成。同樣，ComAdmin的調用方法可以運用到ASP,VC等程序中去。
程序在Windows2000系統下調試通過。有關ComAdmin的詳細信息請參看http://msdn.microsoft.com/library/default.asp?URL=/library/psdk/cossdk/icomadmincatalog_61wu.htm

原文轉自：http://www.anti-gravitydesign.com