windows 2003 COM+组件使用Delphi实现

 本来是一个小程序，却变得较为麻烦了，因为领导的程序需要进行修改，不过数量有些多，想到了批量编译，但是是使用dll的ASP程序，而且是使用COM+组件管理的，只好学习了Com+组件的管理，通过学习网上一篇VB管理COM+组件的文章，照着VB源码翻译成delphi实现。我一向信奉实用至上的。当然理论也少不了，最大的收获是在window下开发，必须要借助MSDN，威力真大啊，也许现在我明白还不算晚吧。

参考资料:

用VB实现COM+组件配置

作者：肖志云    文章来源：VB编程乐园    点击数： <script language="javascript" src="/Article/GetHits.asp?ArticleID=4267" type="text/javascript"></script>    更新时间：2005-4-23

在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://download1.csdn.net/down3//20070121/21005624922.rar

又是一个不眠的凌晨。