ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 4866|回复: 14

[分享] 对象的前期绑定与后期绑定使用方法(CLSID-ProgID对照)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-12-27 12:34 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:Windows API应用
本帖最后由 yangyangzhifeng 于 2016-12-27 18:31 编辑

在学习字典,正则表达式等对象时,我们都知道有后绑定及前绑定的方法,
那么我们怎么知道要引用什么?又要怎样写后绑定代码呢?其实这些信息
都在注册表里面。前期绑定可以引用类型库别名或者类型库文件,字典为例
类库名称引用(A列第二行) Microsoft Scripting Runtime
类库文件引用(A列第一行) C:\WINDOWS\system32\scrrun.dll
后期绑定也有两种形式,一种是用ProgID,一种是直接使用CLSID,
以字典为例:
set d=createobject("Scripting.Dictionary") 'C列
set d=CreateObject("new:{EE09B103-97E0-11CF-978F-00A02463E06F}")'B列
其中第2种实用性更强,因为类型库必须有CLSID,但不一定有ProgID,但用ProgID
会比较好理解。
  本程序可以搜索本机注册表中的所有TypeLib,将文件路径和需要的引用项目列出
在A列,将个类型库的子类列出到B,C,D列,其中B列是CLSID,C列是对应的ProgID
(可能为空),D列是对应的默认名称(可能为空)
  1. Option Explicit


  2. Private Const HKEY_CLASSES_ROOT As Long = &H80000000
  3. Private Const READ_CONTROL As Long = &H20000
  4. Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
  5. Private Const KEY_QUERY_VALUE As Long = &H1
  6. Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
  7. Private Const KEY_NOTIFY As Long = &H10
  8. Private Const SYNCHRONIZE As Long = &H100000
  9. Private Const KEY_READ As Long = (( _
  10.                                   STANDARD_RIGHTS_READ _
  11.                                   Or KEY_QUERY_VALUE _
  12.                                   Or KEY_ENUMERATE_SUB_KEYS _
  13.                                   Or KEY_NOTIFY) _
  14.                                   And (Not SYNCHRONIZE))
  15. Private Const ERROR_SUCCESS As Long = 0&
  16. Private Const ERROR_NO_MORE_ITEMS As Long = 259&
  17. Private Declare Function RegOpenKeyEx _
  18.                           Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
  19.                               ByVal hKey As Long, _
  20.                               ByVal lpSubKey As String, _
  21.                               ByVal ulOptions As Long, _
  22.                               ByVal samDesired As Long, _
  23.                               ByRef phkResult As Long) As Long
  24. Private Declare Function RegEnumKey _
  25.                           Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
  26.                               ByVal hKey As Long, _
  27.                               ByVal dwIndex As Long, _
  28.                               ByVal lpName As String, _
  29.                               ByVal cbName As Long) As Long
  30. Private Declare Function RegQueryValue _
  31.                           Lib "advapi32.dll" Alias "RegQueryValueA" ( _
  32.                               ByVal hKey As Long, _
  33.                               ByVal lpSubKey As String, _
  34.                               ByVal lpValue As String, _
  35.                               ByRef lpcbValue As Long) As Long
  36. Private Declare Function RegCloseKey _
  37.                           Lib "advapi32.dll" ( _
  38.                               ByVal hKey As Long) As Long
  39. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
  40.                                     (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  41. Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
  42.                                          (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As _
  43.                                                                                                                      Long, lpData As Any, lpcbData As Long) As Long
  44. Private Type GUID
  45.     Data1 As Long
  46.     Data2 As Integer
  47.     Data3 As Integer
  48.     Data4(7) As Byte
  49. End Type
  50. Private Declare Function ProgIDFromCLSID Lib "ole32.dll" (ByRef CLSID As Any, ByRef lplpszProgID As Long) As Long
  51. Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As Any) As Long
  52. Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

  53. Dim R As Long
  54. Sub TypeLibList()
  55.     Dim R1 As Long
  56.     Dim R2 As Long
  57.     Dim hHK1 As Long
  58.     Dim hHK2 As Long
  59.     Dim hHK3 As Long
  60.     Dim hHK4 As Long
  61.     Dim i As Long
  62.     Dim i2 As Long
  63.     Dim lpPath As String
  64.     Dim lpGUID As String
  65.     Dim lpName As String
  66.     Dim lpValue As String
  67.     Application.ScreenUpdating = False
  68.     Cells.Clear: R = 1: Cells(1, 1).Resize(1, 4) = Split("类型库文件路径\类型库引用名称|CLSID|ProgID|默认名称", "|")
  69.     lpPath = String$(128, vbNullChar)
  70.     lpValue = String$(128, vbNullChar)
  71.     lpName = String$(128, vbNullChar)
  72.     lpGUID = String$(128, vbNullChar)
  73.     R1 = RegOpenKeyEx(HKEY_CLASSES_ROOT, "TypeLib", ByVal 0&, KEY_READ, hHK1)
  74.     If R1 = ERROR_SUCCESS Then
  75.         i = 0:
  76.         Do While Not R1 = ERROR_NO_MORE_ITEMS
  77.             R1 = RegEnumKey(hHK1, i, lpGUID, Len(lpGUID))
  78.             If R1 = ERROR_SUCCESS Then
  79.                 R2 = RegOpenKeyEx(hHK1, lpGUID, ByVal 0&, KEY_READ, hHK2)
  80.                 If R2 = ERROR_SUCCESS Then
  81.                     i2 = 0
  82.                     Do While Not R2 = ERROR_NO_MORE_ITEMS
  83.                         R2 = RegEnumKey(hHK2, i2, lpName, Len(lpName))    '1.0
  84.                         If R2 = ERROR_SUCCESS Then
  85.                             RegQueryValue hHK2, lpName, lpValue, Len(lpValue)
  86.                             RegOpenKeyEx hHK2, lpName, ByVal 0&, KEY_READ, hHK3
  87.                             RegOpenKeyEx hHK3, "0", ByVal 0&, KEY_READ, hHK4
  88.                             RegQueryValue hHK4, "win32", lpPath, Len(lpPath)
  89.                             i2 = i2 + 1
  90.                             Cells(R + 1, 1) = IIf(InStr(lpPath, vbNullChar), Left(lpPath, InStr(lpPath, vbNullChar) - 1), lpPath) & Chr(10) _
  91.                                               & IIf(InStr(lpValue, vbNullChar), Left(lpValue, InStr(lpValue, vbNullChar) - 1), lpValue) & Chr(10)
  92.                             ProgIDFromFile lpPath
  93.                         End If
  94.                     Loop
  95.                 End If
  96.             End If
  97.             i = i + 1
  98.         Loop
  99.         RegCloseKey hHK1
  100.         RegCloseKey hHK2
  101.         RegCloseKey hHK3
  102.         RegCloseKey hHK4
  103.     End If
  104.     Application.ScreenUpdating = True
  105. End Sub

  106. Private Sub ProgIDFromFile(TypeLibFile$)
  107.     Dim CLSID As GUID, strProgID$, lpszProgID&
  108.     Dim TLIApp As Object
  109.     Dim TLBInfo As Object
  110.     Dim TypeInf As Object
  111.     Set TLIApp = New TLI.TLIApplication
  112.     Dim ProgID As String
  113.     Dim strCLSID As String
  114.     On Error GoTo Exitpoint
  115.     Set TLBInfo = TLIApp.TypeLibInfoFromFile(TypeLibFile)
  116.     For Each TypeInf In TLBInfo.CoClasses
  117.         ProgID = TypeInf.Name
  118.         strCLSID = TypeInf.GUID
  119.         If CLSIDFromString(StrPtr(strCLSID), CLSID) = 0 Then
  120.             R = R + 1: Cells(R, 2) = strCLSID
  121.             Cells(R, 4) = CLSIDDefaultValue(strCLSID)
  122.             If ProgIDFromCLSID(CLSID, lpszProgID) = 0 Then
  123.                 SysReAllocString VarPtr(strProgID), lpszProgID
  124.                 Cells(R, 3) = strProgID
  125.             End If
  126.         End If
  127.     Next
  128. Exitpoint:

  129. End Sub

  130. Private Function CLSIDDefaultValue(strCLSID$) As String
  131.     Dim ret As Long
  132.     Dim key As Long
  133.     Dim length As Long
  134.     ret = RegOpenKey(HKEY_CLASSES_ROOT, "CLSID", key)
  135.     ret = RegOpenKey(key, strCLSID, key)
  136.     '先取数据区的长度
  137.     ret = RegQueryValueEx(key, "", 0, 1, ByVal 0, length)
  138.     '准备数据区
  139.     If length = 0 Then Exit Function
  140.     Dim buff() As Byte
  141.     ReDim buff(length - 1)
  142.     '读取数据
  143.     ret = RegQueryValueEx(key, "", 0, 1, buff(0), length)
  144.     Dim val As String
  145.     '去掉末尾的空字符,VB不需要这个
  146.     ReDim Preserve buff(length - 2)
  147.     '转化为VB中的字符串
  148.     CLSIDDefaultValue = StrConv(buff, vbUnicode)
  149.     RegCloseKey (key)
  150. End Function
复制代码
引用.7z (16.59 KB, 下载次数: 65)

评分

参与人数 4鲜花 +9 收起 理由
ardu95 + 2 优秀作品
⊙⊙小噤○ + 2 优秀作品
fxl447098457 + 2 感谢分享
huang1314wei + 3 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2016-12-27 12:56 | 显示全部楼层
把你的电脑上这个dll文件共享一下,我电脑win10没有这个dll文件

123.png

TA的精华主题

TA的得分主题

发表于 2016-12-27 13:13 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-12-27 13:22 | 显示全部楼层
huang1314wei 发表于 2016-12-27 12:56
把你的电脑上这个dll文件共享一下,我电脑win10没有这个dll文件

你的dll. TLBINF32.rar (52 KB, 下载次数: 70)

评分

参与人数 1鲜花 +3 收起 理由
huang1314wei + 3 感谢帮助,有用

查看全部评分

TA的精华主题

TA的得分主题

发表于 2016-12-27 13:41 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-12-29 18:18 | 显示全部楼层
我写这一帖的目的是方便初学者学习的,在论坛大家学习别人的代码时,
大部分老师为了大家方便利用,一般都用的后期绑定,为了便于学习各
种对象的方法,属性,还是前期绑定方便,因为前期绑定写代码时IDE
会有提示,但是对于初学者来说要找到引用条目不容易,比喻以下项目:
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText strText
        .PutInClipboard
End With
我们知道这个是利用CLSID创建对象,通过搜索CLSID我们知道知道需
要引用C:\WINDOWS\system32\FM20.DLL这个文件,但路径可能和我
的不一定一样.

  今天整理代码发现类库下面的子类与CLSID是多对一,就是不同的类库
可能有相同的子类对应同一个CLSID,而在系统中一个CLSID只对应一个
默认的库文件,现在修正代码,默认的库文件放在E列
  1. Option Explicit


  2. Private Const HKEY_CLASSES_ROOT As Long = &H80000000
  3. Private Const READ_CONTROL As Long = &H20000
  4. Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
  5. Private Const KEY_QUERY_VALUE As Long = &H1
  6. Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
  7. Private Const KEY_NOTIFY As Long = &H10
  8. Private Const SYNCHRONIZE As Long = &H100000
  9. Private Const KEY_READ As Long = (( _
  10.                                   STANDARD_RIGHTS_READ _
  11.                                   Or KEY_QUERY_VALUE _
  12.                                   Or KEY_ENUMERATE_SUB_KEYS _
  13.                                   Or KEY_NOTIFY) _
  14.                                   And (Not SYNCHRONIZE))
  15. Private Const ERROR_SUCCESS As Long = 0&
  16. Private Const ERROR_NO_MORE_ITEMS As Long = 259&
  17. Private Declare Function RegOpenKeyEx _
  18.                           Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
  19.                               ByVal hKey As Long, _
  20.                               ByVal lpSubKey As String, _
  21.                               ByVal ulOptions As Long, _
  22.                               ByVal samDesired As Long, _
  23.                               ByRef phkResult As Long) As Long
  24. Private Declare Function RegEnumKey _
  25.                           Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
  26.                               ByVal hKey As Long, _
  27.                               ByVal dwIndex As Long, _
  28.                               ByVal lpName As String, _
  29.                               ByVal cbName As Long) As Long
  30. Private Declare Function RegQueryValue _
  31.                           Lib "advapi32.dll" Alias "RegQueryValueA" ( _
  32.                               ByVal hKey As Long, _
  33.                               ByVal lpSubKey As String, _
  34.                               ByVal lpValue As String, _
  35.                               ByRef lpcbValue As Long) As Long
  36. Private Declare Function RegCloseKey _
  37.                           Lib "advapi32.dll" ( _
  38.                               ByVal hKey As Long) As Long
  39. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
  40.                                     (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  41. Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
  42.                                          (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As _
  43.                                                                                                                      Long, lpData As Any, lpcbData As Long) As Long
  44. Private Type GUID
  45.     Data1 As Long
  46.     Data2 As Integer
  47.     Data3 As Integer
  48.     Data4(7) As Byte
  49. End Type
  50. Private Declare Function ProgIDFromCLSID Lib "ole32.dll" (ByRef CLSID As Any, ByRef lplpszProgID As Long) As Long
  51. Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As Any) As Long
  52. Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

  53. Dim R As Long
  54. Sub TypeLibList()
  55.     Dim R1 As Long
  56.     Dim R2 As Long
  57.     Dim hHK1 As Long
  58.     Dim hHK2 As Long
  59.     Dim hHK3 As Long
  60.     Dim hHK4 As Long
  61.     Dim i As Long
  62.     Dim i2 As Long
  63.     Dim lpPath As String
  64.     Dim lpGUID As String
  65.     Dim lpName As String
  66.     Dim lpValue As String
  67.     Application.ScreenUpdating = False
  68.     Cells.Clear: R = 1: Cells(1, 1).Resize(1, 5) = Split("类型库文件路径\类型库引用名称|CLSID|ProgID|默认名称|CLSID对应的库文件", "|")
  69.     lpPath = String$(128, vbNullChar)
  70.     lpValue = String$(128, vbNullChar)
  71.     lpName = String$(128, vbNullChar)
  72.     lpGUID = String$(128, vbNullChar)
  73.     R1 = RegOpenKeyEx(HKEY_CLASSES_ROOT, "TypeLib", ByVal 0&, KEY_READ, hHK1)
  74.     If R1 = ERROR_SUCCESS Then
  75.         i = 0:
  76.         Do While Not R1 = ERROR_NO_MORE_ITEMS
  77.             R1 = RegEnumKey(hHK1, i, lpGUID, Len(lpGUID))
  78.             If R1 = ERROR_SUCCESS Then
  79.                 R2 = RegOpenKeyEx(hHK1, lpGUID, ByVal 0&, KEY_READ, hHK2)
  80.                 If R2 = ERROR_SUCCESS Then
  81.                     i2 = 0
  82.                     Do While Not R2 = ERROR_NO_MORE_ITEMS
  83.                         R2 = RegEnumKey(hHK2, i2, lpName, Len(lpName))    '1.0
  84.                         If R2 = ERROR_SUCCESS Then
  85.                             RegQueryValue hHK2, lpName, lpValue, Len(lpValue)
  86.                             RegOpenKeyEx hHK2, lpName, ByVal 0&, KEY_READ, hHK3
  87.                             RegOpenKeyEx hHK3, "0", ByVal 0&, KEY_READ, hHK4
  88.                             RegQueryValue hHK4, "win32", lpPath, Len(lpPath)
  89.                             i2 = i2 + 1
  90.                             Cells(R + 1, 1) = IIf(InStr(lpPath, vbNullChar), Left(lpPath, InStr(lpPath, vbNullChar) - 1), lpPath) & Chr(10) _
  91.                                               & IIf(InStr(lpValue, vbNullChar), Left(lpValue, InStr(lpValue, vbNullChar) - 1), lpValue) & Chr(10)
  92.                             ProgIDFromFile lpPath
  93.                         End If
  94.                     Loop
  95.                 End If
  96.             End If
  97.             i = i + 1
  98.         Loop
  99.         RegCloseKey hHK1
  100.         RegCloseKey hHK2
  101.         RegCloseKey hHK3
  102.         RegCloseKey hHK4
  103.     End If
  104.     Application.ScreenUpdating = True
  105. End Sub

  106. Private Sub ProgIDFromFile(TypeLibFile$)
  107.     Dim CLSID As GUID, strProgID$, lpszProgID&
  108.     Dim TLIApp As Object
  109.     Dim TLBInfo As Object
  110.     Dim TypeInf As Object
  111.     Set TLIApp = New TLI.TLIApplication
  112.     Dim ProgID As String
  113.     Dim strCLSID As String
  114.     On Error GoTo Exitpoint
  115.     Set TLBInfo = TLIApp.TypeLibInfoFromFile(TypeLibFile)
  116.     For Each TypeInf In TLBInfo.CoClasses
  117.         ProgID = TypeInf.Name
  118.         strCLSID = TypeInf.GUID
  119.         If CLSIDFromString(StrPtr(strCLSID), CLSID) = 0 Then
  120.             R = R + 1: Cells(R, 2) = strCLSID
  121.             Cells(R, 4) = CLSIDDefaultValue(strCLSID)(0)
  122.             Cells(R, 5) = CLSIDDefaultValue(strCLSID)(1)
  123.             If ProgIDFromCLSID(CLSID, lpszProgID) = 0 Then
  124.                 SysReAllocString VarPtr(strProgID), lpszProgID
  125.                 Cells(R, 3) = strProgID
  126.             End If
  127.         End If
  128.     Next
  129. Exitpoint:

  130. End Sub

  131. Private Function CLSIDDefaultValue(strCLSID$)
  132.     Dim ret As Long
  133.     Dim key As Long
  134.     Dim length As Long
  135.     Dim temp$(0 To 1)
  136.     ret = RegOpenKey(HKEY_CLASSES_ROOT, "CLSID", key)
  137.     ret = RegOpenKey(key, strCLSID, key)
  138.     '先取数据区的长度
  139.     ret = RegQueryValueEx(key, "", 0, 1, ByVal 0, length)
  140.     '准备数据区
  141.     If length > 0 Then
  142.         Dim buff() As Byte
  143.         ReDim buff(length - 1)
  144.         '读取数据
  145.         ret = RegQueryValueEx(key, "", 0, 1, buff(0), length)
  146. '        Dim val As String
  147.         '去掉末尾的空字符,VB不需要这个
  148.         ReDim Preserve buff(length - 2)
  149.         '转化为VB中的字符串
  150.         temp(0) = StrConv(buff, vbUnicode)
  151.     End If
  152.     ret = RegOpenKey(key, "InprocServer32", key)
  153.     ret = RegQueryValueEx(key, "", 0, 1, ByVal 0, length)
  154.     If length > 0 Then
  155.         
  156.         ReDim buff(length - 1)
  157.         '读取数据
  158.         ret = RegQueryValueEx(key, "", 0, 1, buff(0), length)
  159.         
  160.         '去掉末尾的空字符,VB不需要这个
  161.         ReDim Preserve buff(length - 2)
  162.         '转化为VB中的字符串
  163.         temp(1) = StrConv(buff, vbUnicode)
  164.     End If
  165.     CLSIDDefaultValue = temp
  166.     RegCloseKey (key)
  167. End Function
复制代码
引用.7z (17.57 KB, 下载次数: 56)

TA的精华主题

TA的得分主题

发表于 2017-2-25 10:33 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-2-25 11:41 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-3-16 15:20 | 显示全部楼层
0031126 发表于 2017-2-25 11:41
运行出错了,请问是什么原因呢。

遇到相同错误,楼主分享解答下呗

TA的精华主题

TA的得分主题

发表于 2017-3-16 15:24 | 显示全部楼层
yangyangzhifeng 发表于 2016-12-29 18:18
我写这一帖的目的是方便初学者学习的,在论坛大家学习别人的代码时,
大部分老师为了大家方便利用,一般都 ...

楼主真是个好心人啊,新人遇到这类问题每每放弃的节奏。

2017-03-16_152141.jpg
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-12-12 08:17 , Processed in 0.413158 second(s), 23 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表