再谈CreateObject函数，VBS到底能调用哪些对象？

VBS的CreateObject函数到底能够创建哪些对象，几乎是每个VBS新手都困惑的问题，他们总是热衷于寻找“VBS对象大全”。

对于系统中存在哪些对象，UMU在《[UMU WSH 教程](9)CreateObject 过程》中有过这样的回答：

对象的注册信息 HKEY_CLASSES_ROOT\CLSID\{GUID} 下可能会有这样的一些子键：Control 说明该组件是一个 ActiveX 控件、Programmable 说明该组件支持自动化、Insertable 说明该组件可以被嵌入到一个 OLE 文档容器中。能找到 Programmable，说明支持自动化，也就是支持 IDispatch 接口，所以它可以被脚本语言使用。不过这种方式比较老了，现在已经被一个的组件类属代替，即 Implemented Categories 子键下面的 GUID 形式的子键。比如 HKEY_CLASSES_ROOT\CLSID\{72C24DD5-D70A-438B-8A42-98424B88AFB8}\Implemented Categories\{40FC6ED5-2438-11CF-A3DB-080036F12502}，看一下 HKEY_CLASSES_ROOT\Component Categories\{40FC6ED5-2438-11CF-A3DB-080036F12502} 下的 409 字符串值为 Automation Objects，也就是“自动化对象”。

也就是说，如果注册表中一个对象的ProgID对应的CLSID下包含有子键Programmable或者Implemented Categories\{40FC6ED5-2438-11CF-A3DB-080036F12502}，那么这个对象就能用CreateObject函数创建。

假设上面的说法正确，那么我们可以用下面的脚本获取“VBS对象大全”：

Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000
Dim arrProgID, strProgID, strCLSID
Dim objReg, objFso, objFile, objShell

Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Set objFile = objFso.OpenTextFile("ProgID.txt", 2, True)

'By Demon
'https://demon.tw

objReg.EnumKey HKEY_CLASSES_ROOT, "", arrProgID
For Each strProgID In arrProgID
    If GetCLSID(strProgID, strCLSID) Then
        If IsProgrammable(strCLSID) Or IsAutomationObject(strCLSID) Then
            objFile.WriteLine strProgID
        End If
    End If
Next
objShell.Run "ProgID.txt"

Function RegKeyExists(hKey, strSubKey)
    Dim a, n
    n = objReg.EnumKey(hKey, strSubKey, a)
    If n = 0 Then
        RegKeyExists = True
    Else
        RegKeyExists = False
    End If
End Function

Function IsAutomationObject(strCLSID)
    Dim strSubKey
    IsAutomationObject = False
    strSubKey = "CLSID\" & strCLSID & "\Implemented Categories"
    If RegKeyExists(HKEY_CLASSES_ROOT, strSubKey) Then
        strSubKey = strSubKey & "{40FC6ED5-2438-11CF-A3DB-080036F12502}"
        If RegKeyExists(HKEY_CLASSES_ROOT, strSubKey) Then
            IsAutomationObject = True
        End If
    End If
End Function

Function IsProgrammable(strCLSID)
    IsProgrammable = RegKeyExists(HKEY_CLASSES_ROOT, _
        "CLSID\" & strCLSID & "\Programmable")
End Function

Function GetCLSID(strProgID, strCLSID)
    Dim s
    GetCLSID = False
    If RegKeyExists(HKEY_CLASSES_ROOT, strProgID & "\CLSID") Then
        objReg.GetStringValue HKEY_CLASSES_ROOT, strProgID & "\CLSID", "", s
        If Not IsNull(s) Then
            strCLSID = s
            GetCLSID = True
        End If
    End If
End Function

上面的脚本显示在我的系统中存在1000多个对象可以调用。哇！VBS居然可以调用那么多对象！别高兴得太早，我前面说了“假设上面的说法正确”。实际上，UMU的说法并不完全正确，Programmable或者Implemented Categories为{40FC6ED5-2438-11CF-A3DB-080036F12502}的对象也不一定能够用CreateObject创建，比如我系统中有一个ComCtl3.Band就属于这种情况；另外，某些对象并没有Programmable或者Implemented Categories，但是照样可以用CreateObject创建，比如说WindowsInstaller.Installer。

所以不能单纯依靠注册表的是非存在Programmable或者Implemented Categories来判断，那么如果来判断呢？一种方法是根据《VBS技术内幕：CreateObject函数》里面说的，写一个C++程序来模拟CreateObject函数，判断对象是否支持IDispatch接口。不过这样太麻烦了，比较简单的方法是让CreateObject函数自己来判断：

Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000
Dim arrProgID, strProgID, strCLSID
Dim objReg, objFso, objFile, objShell, O

Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Set objFile = objFso.OpenTextFile("ProgID.txt", 2, True)

'By Demon
'https://demon.tw

objReg.EnumKey HKEY_CLASSES_ROOT, "", arrProgID
For Each strProgID In arrProgID
    If GetCLSID(strProgID, strCLSID) Then
        If IsCreatable(strProgID) Then
            objFile.WriteLine strProgID
        End If
    End If
Next
objShell.Run "ProgID.txt"

Function IsCreatable(strProgID)
    On Error Resume Next
    Dim O
    Set O = CreateObject(strProgID)
    If Err.Number = 0 Then
        IsCreatable = True
    Else
        IsCreatable = False
    End If
    Set O = Nothing
    Err.Clear
End Function

Function RegKeyExists(hKey, strSubKey)
    Dim a, n
    n = objReg.EnumKey(hKey, strSubKey, a)
    If n = 0 Then
        RegKeyExists = True
    Else
        RegKeyExists = False
    End If
End Function

Function GetCLSID(strProgID, strCLSID)
    Dim s
    GetCLSID = False
    If RegKeyExists(HKEY_CLASSES_ROOT, strProgID & "\CLSID") Then
        objReg.GetStringValue HKEY_CLASSES_ROOT, strProgID & "\CLSID", "", s
        If Not IsNull(s) Then
            strCLSID = s
            GetCLSID = True
        End If
    End If
End Function

说了这么多，其实我真正想说的是，就算你用上面的脚本得到了“VBS对象大全”又有什么意义呢？我敢肯定的告诉你，这些对象里面有95%以上你从来都见过，也不知道它们是做什么的，更不用说去调用。

我常用的VBS对象只有下面几个：

ADODB.Stream
InternetExplorer.Application
Msxml2.XMLHTTP
Scripting.Dictionary
Scripting.FileSystemObject
Shell.Application
WScript.Shell

把这些对象都弄懂了，VBS基本上就入门了。

随机文章:

1. 未能正确加载“Microsoft.VisualStudio.Editor.Implementation.EditorPackage”包
2. 关于VBS调用MSWinsock控件
3. VBS实现全角字符转半角字符
4. MulDiv函数
5. PHP调用COM组件

这篇文章发布于 2013年04月29日，星期一，19:31，归类于 程序设计。 您可以跟踪这篇文章的评论通过 RSS 2.0 feed。 您可以留下评论，或者从您的站点trackback。