我看了:
《用VB实现COM+组件配置》作者:肖志云
照着文中的代码,用VB做了个演示
其它功能都成功了,就是安装组件怎么试都不成功!
谁有经验的,说说这是怎么回事啊?附原文:首先在定义变量如下
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
《用VB实现COM+组件配置》作者:肖志云
照着文中的代码,用VB做了个演示
其它功能都成功了,就是安装组件怎么试都不成功!
谁有经验的,说说这是怎么回事啊?附原文:首先在定义变量如下
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
解决方案 »
- 求vb分词算法
- 小弟急求压缩、解压插件,哪里可以下载到,在线等!
- VB+SQL2000连接数据库中的一个表出现的问题(请好心人帮忙指导!急!!)
- 我用Shell("NOTEPAD.EXE app.path\使用说明.txt ", 1)打开写字板,但不能打开我的文件(使用说明.txt),提示找不到路径,我的文件放在我
- datareport中怎么设置起始页?想让起始页不是1
- 全组合需要12个小时才能算出45选6的全部组合。有没有办法改进一下运行时间呢。程序代码如下:注意是VFP的,我只会这个编程。
- mschart问题
- 关于网络的问题,我想访问局域网中某机器的共享文件夹,我有权利设置该文件夹,但是我不想让任何人修改该机器的文件,请问怎么办?
- 哪里有ie6.0 or ie5.1 的完整繁体中文版下载?微软站上的好像都是网络部分版的。
- 如何改变它的值???100分重酬
- 添加记录的问题。初学者,急!!!
- MSDN的下载地址??
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文件)的完整路径)
我仿写的VB演示,可以成功调用上面addcomponent方法,但是实际上没有安装上去。
1。你选择的DLL没有注册。
2。已经注册 ,如: a.dll 在c:\ 目录下,a.dll 在d:\目录下也有,如是以c:\ 目录下注册的,那么
你选择d:\目录下也的a.dll安装。也会失败。楼主,结账吧。