用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 |
浙公网安备 33010602011771号