用VB实现COM+组件配置
用VB实现COM+组件配置
http://www.ccw.com.cn/htm/app/aprog/01_5_11_2.asp
http://www.ccw.com.cn/htm/app/aprog/01_5_11_2.asp
用VB实现COM+组件配置肖志云 |
01-5-11 上午 10:50:59 |
在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 |