@H_
301_0@用VB实现COM+组件配置作者：肖志云在Windwos2000的管理工具里有一个“组件服务”工具，可以实现对COM+组件的应用的安装、启动、
删除和对组件的安装、
删除。这在安装一个有COM+组件的应用系统时时非常有用的，我们可以通过程序控制一个组件
添加删除，可以通过程序实现这个过程的
自动化，而不必人工停止应用再安装组件！现在我们来讨论怎样用VB程序实现这个工具的这些
功能。一、COMAdmin接口简介COMAdmin接口是实现这些
功能的关键对象，它有有三个基本接口,分别是IcomAdminCatalog,IcatalogCollection,Icata
logobject,
调用这三个接口的相关
属性方法可以实现对COM组件的
添加、
删除、应用的
添加、
删除、启动、
关闭等
功能。1、IcomadminCatalog接口介绍IcomAdminCatalog接口代表COM+ Catalog本身。
方法：GetCollection可以取得COM+ Catalog中包含的集合。2、IcatalogCollection接口介绍IcatalogCollection接口可以枚举
内容、读取、
增加、
删除集合项目。
方法：Populate让集合填入
内容；
方法：PopulateBykey同Populate,但让集合从akeys指定项读取数值；
方法：remove
删除一个对象，参数是对象在集合中的索引；
方法：SaveChanges保存对
属性的改变，无参数，返回保存的改变
次数。3、Icata
logobject接口介绍
属性：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 ExplicitPublic ocatalog As COMAdminCatalogPublic ocatcol As COMAdminCatalogCollectionPublic ocatobj As COMAdminCata
logobject然后我们定义一个
函数实现取得COM+应用的集合.Private Function createocatalog() As Booleancreateocatalog = False注释：创建catalog对象Set ocatalog = New COMAdminCatalog注释：得到应用连接Set ocatcol = ocatalog.GetCollection("Applications")createocatalog = TrueEnd Function接下来我们在Form的启动事件里写上如下
代码：Private Sub Form_Load()If App.PrevInstance ThenUnload MeMsg
Box "程序已经运行！"Exit SubEnd Ifform1.ShowIf createocatalog() ThenStatusBar1.Panels(2) = "连接COMADMIN成功"displayobjects ocatcolElseStatusBar1.Panels(2) = "连接COMADMIN失败!"Msg
Box "连接失败，请确认系统是否安装的组件服务！"End IfEnd 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 errdSet ocatobj = ocatcol.Add 注释：
添加一个新应用ocatobj.Value("Name") = name 注释：设置这个应用的
属性ocatobj.Value("Activation") = activationocatobj.Value("Identity") = Identityocatcol.SaveChanges 注释：保存关于ocatcol对象的改变addapp = "OK"Exit Functionerrd:addapp = Err.Description 注释：如果出错返回
错误信息End Function（addapp
函数实现
添加一个组件应用,参数name是要为这个新应用确定一个名字，我们可以默认是NewApplication,Activation和Indentity分别是配置这个应用的相关
属性）Public Function deleteapp(name As String) As String 注释：参数name是应用的PROGIDIf name <> "" ThenDim oo As ObjectDim i As Integeri = 0On Error GoTo errdocatcol.Populate 注释：首次取得目录集合时，缺省为空，需要
调用Populate来填入
内容For Each oo In ocatcolIf oo.name = name Thenocatcol.Remove i 注释：
删除索引号为i的组件应用ocatcol.SaveChanges 注释：保存End Ifi = i + 1NextEnd Ifdeleteapp = "ok"Exit Functionerrd:addapp = Err.DescriptionEnd Function（
函数deleteapp实现
删除名字为name的一个组件应用。）Public Function startobject(name As String) As String 注释：参数name是应用的PROGIDDim oo As ObjectOn error goto errdocatcol.PopulateFor Each oo In ocatcolIf oo.name = name Thenocatalog.StartApplication oo.Key 注释：启动一个应用End IfNextstartobject = "OK"Exit functionerrd: 注释：
错误处理startobject = Err.DescriptionEnd Function（
函数startobject实现启动名字为name的一个组件应用。）Public Function stopobject(name As String) As StringDim oo As ObjectOn error goto errdocatcol.PopulateFor Each oo In ocatcolIf oo.name = name Thenocatalog.ShutdownApplication oo.Key 注释：停止这个应用End IfNextStopobject = "OK"Exit funcitionErrd:Stopobject = Err.Description.End Function（Stopobject
函数实现停止一个应用）到这里我们已经实现了对应用的控制，下面我们来实现对组件的控制。Public Function addcomponent(name As String,filename As String) As StringDim oo As ObjectOn error goto errdFor Each oo In ocatcolIf oo.name = name Thenocatalog.InstallComponent name,filename,"","" 注释：在这里实现安装组件到一个应用End Ifaddcomponent = "OK"exit functionNextErrd:addcomponent = err. DescriptionEnd Function（addcomponent实现在一个应用里安装一个新的组件，参数name是应用名(PROGID),filename是组件
文件(即.DLL
文件)的完整路径）Public Function deletecomponent(name As String,componentname As String) As StringDim oo As ObjectDim okey As VariantDim components As ObjectDim i As IntegerOn error goto errdocatcol.PopulateFor Each oo In ocatcolIf oo.name = name Thenokey = oo.KeyEnd IfNextSet components = ocatcol.GetCollection("Components",okey)components.PopulateIf components.Count > 0 Theni = 0For Each oo In componentsIf oo.name = componentname Thencomponents.Remove icomponents.SaveChangesEnd Ifi = i + 1NextDeletecomponent = "OK"Exit functionElseDeletecomponent = "当前选择应用中没有组件！"End IfErrd:Deletecomponent = err. DescriptionEnd Function（Deletecomponent实现在一个应用里
删除一个组件，参数name是应用名(PROGID),componentname是组件名(即组件的PROGID)）到这里，我们已经可以
调用这些
函数实现对组件的控制了，下面我们就来看看怎么样
调用这些
函数实现对组件的完全控制。首先我们还需要
添加两个过程：Public Sub displayobjects(CurrentConnection As COMAdminCatalogCollection)Dim oo As ObjectCurrentConnection.PopulateWith lbobject.ClearFor Each oo In CurrentConnection.AddItem oo.name 注释：我们将取得的对象集合的的应用名
添加到对象列表框中去NextEnd WithEnd Sub（displayobjects过程实现将传入的集合
显示在应用列表框中去）Public Function disaplaycomponent(name As String,CurrentConnection As _COMAdminCatalogCollection) 注释：name是应用名，CurrentConnection是已经取得应用对象的集合Dim oo As ObjectDim okey As VariantDim components As ObjectCurrentConnection.PopulateFor Each oo In CurrentConnectionIf oo.name = name Thenokey = oo.Key 注释：取得CurrentConnection集合中名为name的应用的CLSIDEnd IfNextSet components = CurrentConnection.GetCollection("Components",okey)components.PopulateWith lbcomponent.ClearFor Each oo In components.AddItem oo.name 注释：将组件名
添加进组件列表框中NextEnd WithEnd Function（displayobjects过程实现将传入的应用的组件
显示在组件列表框中）好，有了这些
函数过程，我们就能
调用他们实现对应用、组件的
显示和控制了。下面的
代码是
调用这些
函数的例子。Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)Select Case Button.IndexCase Is = 1 注释：刷新列表displayobjects ocatcolStatusBar1.Panels(1) = "刷新列表:"StatusBar1.Panels(2) = "刷新列表成功！"Case Is = 2 注释：
添加应用form2.Show vbModal,MeStatusBar1.Panels(1) = "
添加应用："StatusBar1.Panels(2) = "
添加应用成功！"Case Is = 3 注释：
删除应用If lbobject.Text <> "" Thendeleteapp lbobject.Textdisplayobjects ocatcolStatusBar1.Panels(1) = "
删除应用："StatusBar1.Panels(2) = "
删除应用成功！"ElseMsg
Box "请选择一个应用！"End IfCase Is = 4 注释：启动当前应用If lbobject.Text <> "" ThenStatusBar1.Panels(1) = "启动当前应用："StatusBar1.Panels(2) = "正在启动当前应用．．．"startobject lbobject.TextStatusBar1.Panels(2) = "启动当前应用成功！"ElseMsg
Box "请选择一个应用！"End IfCase Is = 5 注释：停止应用If lbobject.Text <> "" ThenStatusBar1.Panels(1) = "停止当前应用："StatusBar1.Panels(2) = "正在
关闭当前应用．．．"stopobject lbobject.TextStatusBar1.Panels(2) = "正在
关闭当前应用成功！"ElseMsg
Box "请选择一个应用！"End IfCase Is = 6 注释：安装组件If lbobject.Text <> "" ThenOn Error GoTo errhandlerCommonDialog1.Filter = "组件
文件 (*.dll) | *.dll"CommonDialog1.ShowOpenDim filename As Stringfilename = Trim$(CommonDialog1.filename)StatusBar1.Panels(1) = "安装组件："StatusBar1.Panels(2) = "正在将组件安装进当前应用．．．"addcomponent lbobject.Text,filenameStatusBar1.Panels(2) = "组件安装成功！"disaplaycomponent lbobject.Text,ocatcolExit SubElseMsg
Box "请选择一个应用，再安装组件！"End Iferrhandler:注释：按了cancel按钮Exit SubCase Is = 7 注释：
删除组件If lbobject.Text = "" ThenMsg
Box "请选择一个应用！"Exit SubEnd IfIf lbcomponent.Text = "" ThenMsg
Box "请选择一个组件！"Exit SubEnd Ifdeletecomponent lbobject.Text,lbcomponent.TextStatusBar1.Panels(1) = "
删除组件："StatusBar1.Panels(2) = "
删除组件成功！"disaplaycomponent lbobject.Text,ocatcolCase Is = 8 注释：关于程序Msg
Box "这个程序是COM组件的控制的程序,VB6.0开发，在win2000下调试通过！欢迎指教！"End SelectEnd Sub到这里程序完成。同样，ComAdmin的
调用方法可以运用到ASP,VC等程序中去。程序在Windows2000系统下调试通过。有关ComAdmin的详细信息请参看http://msdn.microsoft.com/library/default.asp?URL=/library/psdk/cossdk/icomadmincatalog_61wu.htm
原文链接：https://www.f2er.com/vb/262135.html
