reflection - 列出对象方法和属性

Question

有没有办法列出 VBS 中创建的对象的可用方法？

例如:

Set IE = CreateObject("InternetExplorer.Application")

我想列出这个对象的可用属性，如:

IE.AddressBar
IE.Application
IE.Busy
...

或方法:

IE.ClientToWindow
IE.ExecWB
IE.GetProperty
...

如何在 VBS 中发现任意有效对象的可用属性？

Answer 1

使用 TypeLib Information Objects 中的 tlbinf32.dll 可以列出类的所有成员。

`tlbinf32.dll` 是 *Visual Studio 6.0* 的一部分，它是 2000 年左右的当前版本。Microsoft 似乎不再提供 DLL 供下载(2017 年中期的情况)，但您可以从各种站点下载它互联网。我在 https://www.dll4free.com/tlbinf32.dll.html 或其他网站上找到了版本 *1.1.88.4、Build 8804、版权 Matthew Curland 1996、Microsoft 1997-2000、大小 148.480 字节*。

要在 Win32 中安装 DLL，请将其复制到 `%windir%\System32` 并 *作为管理员* 从该目录调用 `regsvr32.exe tlbinf32.dll`。

要在 Win64 中安装 DLL，请将其复制到 `%windir%\syswow64`，然后*以管理员身份* 注册到 `%windir%\syswow64\regsvr32.exe`，最后使用 `%windir%\syswow64\运行 vbscript cscript.exe`(或`wscript.exe`)。感谢 [BuvinJ](/users/3220983/buvinj) 的 [提示](/questions/14305750/list-object-methods-and-properties/44459670?noredirect=1#comment86169321_44459670)
以下脚本演示了包含的函数 VariableInfo，它将返回一个字符串，其中包含传递变量的类型，如果是 Object，则返回所有成员的详细信息，包括 Property 的类型、可调用类型(Sub 或 Function)以及参数名称和函数的返回类型。如果是 COM 对象，对象的类型名称将是已实现接口(interface)的名称。不确定它是否适用于多个实现的接口(interface)，但 AFAIK 无论如何都不可能通过 COM 在一个类中实现多个接口(interface)。
它不以任何方式支持递归，因为这会导致某些类型的无限循环。
这个 会给你 在 VBS 中几乎完全工作的 反射 。非常适合探索 API，例如使用 Microsoft Script Debugger。

' Reflection for VBScript via tlbinfo32.dll
'
' Patrick Strasser-Mikhail 2017-2021
' Ansgar Wiechers 2019
' https://stackoverflow.com/questions/14305750/list-object-methods-and-properties/44459670#44459670
'
' v1.1 2021-02-01: Show values of arrays and objects, but only one level


' Returns a String describing the passed object/variable on the first level,
' no recursion.
Function VariableInfo(obj)
    VariableInfo = VariableInfoToLevel(obj, 0, 1)
End Function

' Returns a String describing the passed object/variable on the first level,
' recurse down to level max_level(0=no recursion).
Function VariableInfoToLevel(obj, level, max_level)
    Const invokeKindPropertyGet = 0     ' simple data member
    Const invokeKindFunction = 1        ' method: Sub or Function
    Const invokeKindPropertyPut = 2     ' Docs: has a value setter; reality: more like is settable
    Const invokeKindPropertyPutRef = 4  ' Docs: has a reference setter; reality: more like is not settable

    If level > max_level Then
        VariableInfoToLevel = ""
        Exit Function
    End If

    Dim indent : indent = Space(4 * level)
    VariableInfoToLevel = indent

    If isEmpty(obj) Or _
       isNull(obj) _
    Then
        VariableInfoToLevel = VariableInfoToLevel & TypeNameFromVarType(VarType(obj))
    ElseIf Not IsObject(obj) Then
        If Not isArray(obj) Then
            VariableInfoToLevel = indent & TypeNameFromVarType(VarType(obj)) & ", Value: [" & obj & "]"
        Else
            VariableInfoToLevel = indent & TypeNameFromVarType(VarType(obj))
            Dim dimension
            ReDim sizes(0)
            Dim size

            On Error Resume Next
            Err.Clear

            For dimension = 0 To 10 ' deliberate limit to prevent infinite loop
                size = Ubound(obj, dimension + 1)
                If Err.Number <> 0 Then
                    ' report ther then Index out of Bounds
                    If Err.Number <> 9 Then 
                        WScript.Echo "Exception " & Err.Number & ": " & Err.Description & "; in " & Err.Source
                    End If
                    Exit For
                End If
                ReDim Preserve sizes(dimension)
                sizes(dimension) = size  
            Next
            On Error Goto 0

            VariableInfoToLevel = VariableInfoToLevel & "(" & Join(sizes, ",") & ")"
            Select Case dimension
              Case 1
                VariableInfoToLevel = VariableInfoToLevel & " {"  & vbCrlf
                Dim idx
                For idx = LBound(obj) To UBound(obj)
                    VariableInfoToLevel = VariableInfoToLevel & indent & _
                        "     " & idx & ":" & _
                        Trim(VariableInfoToLevel(obj(idx), level + 1, max_level)) & vbCrlf
                Next

                VariableInfoToLevel = VariableInfoToLevel & indent & "}" & vbCrlf
                
              Case 2
                VariableInfoToLevel = indent & "{" & vbCrlf

                Dim idx1, idx2
                For idx1 = LBound(obj, 1) To UBound(obj, 1)
                    For idx2 = LBound(obj, 2) To UBound(obj, 2)
                        VariableInfoToLevel = VariableInfoToLevel & indent & _
                            "     " & idx1 & "," & idx2 & ":" & _
                            Trim(VariableInfoToLevel(obj(idx1, idx2), level + 1, max_level)) & vbCrlf
                    Next
                Next

                VariableInfoToLevel = VariableInfoToLevel & indent & "    }" & vbCrlf
              
              Case Else
                ' 0 is empty anyway, more is too complicated to print, just leave it for now
            End Select
        End If
    ElseIf TypeName(obj) = "Nothing" Then
        VariableInfoToLevel = indent & "Nothing (The Invalid Object)"
    Else
        ' Object
        VariableInfoToLevel = indent & "Object " & TypeName(obj)
        '' Need to think about that... True for Err, but not for System.Dictionary
        '' Seems Err is very special, and we should compare explicitly with internal/predifined Objects (Err, WScript)
        'If varType(obj) <> vbObject Then
            ' hm, interresting...
        '   VariableInfoToLevel = VariableInfoToLevel & " with default property (no analysis possible)"
        '   Exit Function
        'End If
            
        Dim TLI
        Dim MemberInfo
        Dim TypeInfo
        Set TLI = CreateObject("TLI.TLIApplication")
        VariableInfoToLevel = indent & "Object " & TypeName(obj)

        On Error Resume Next
        Err.Clear
        Set TypeInfo = TLI.InterfaceInfoFromObject(obj)
        
        If Err.Number <> 0 Then
            
            VariableInfoToLevel = VariableInfoToLevel & "; Error " & Err.Number
            VariableInfoToLevel = VariableInfoToLevel & ": " & Err.Description
            Err.Clear
            On Error Goto 0
            Exit Function
        End If
        On Error Goto 0
        
        
        For Each MemberInfo In TypeInfo.Members
            Dim Desc
            Dim printNextLevel : printNextLevel = vbFalse
            Desc = ""
            ' based on .Net System.Runtime.IteropService.ComTypes
            '' FIXME: Call by Value/Reference and settable seems to be switched some
            '' InvokeKind seems to not encode value passing, rather settable/not settable
            '' Needs more work to decode byValue/byReference
            Select Case MemberInfo.InvokeKind
                Case InvokeKindFunction
                    If MemberInfo.ReturnType.VarType <> 24 Then
                        Desc = "  Function " & TypeNameFromVarType(MemberInfo.ReturnType.VarType)
                    Else
                        Desc = "  Sub"
                    End If

                    Desc = Desc & " " & MemberInfo.Name
                    Dim ParameterList
                    ParameterList = Array()
                    Dim Parameter
                    For Each Parameter In MemberInfo.Parameters
                        ReDim Preserve parameterList(UBound(ParameterList) + 1)
                        ParameterList(Ubound(parameterList)) = Parameter.Name
                    Next
                    Desc = Desc & "(" & Join(ParameterList, ", ") & ")"
                    'Set parameters = Nothing
                Case InvokeKindPropertyGet
                    Desc = "  Data Member " & MemberInfo.Name
                    printNextLevel = vbTrue
                Case InvokeKindPropertyPut
                    ' Seems to be 
                    Desc = "  Property " & MemberInfo.Name & " [set by val"
                    If IsGettable(obj, MemberInfo.Name) Then 
                        Desc = Desc & "/get"
                        printNextLevel = vbTrue
                    End If
                    Desc = Desc & "]"
                    'Stop
                Case InvokeKindPropertyPutRef
                    'Stop
                    Desc = "  Property " & MemberInfo.Name & " [set by ref"
                    If IsGettable(obj, MemberInfo.Name) Then 
                        Desc = Desc & "/get"
                        printNextLevel = vbTrue
                    End If
                    Desc = Desc & "]"
                    'Stop
                Case Else
                    Desc = "  Unknown member, InvokeKind " & MemberInfo.InvokeKind
            End Select
            VariableInfoToLevel = VariableInfoToLevel & vbNewLine & _
                                  indent & Desc
            If printNextLevel And level < max_level Then
                VariableInfoToLevel = VariableInfoToLevel & vbNewLine & _
                    VariableInfoToLevel(eval("obj." & MemberInfo.Name), level + 1, max_level)
            End If
        Next

        Set TypeInfo = Nothing
        Set TLI = Nothing
    End If
End Function

Function IsGettable(obj, memberName)
    Dim value
    On Error Resume Next
    Err.Clear
    value = eval("obj." & memberName)
    Stop
    If Err.Number <> 0 And _
       Err.Number <> 438 And _
       Err.Number <> 450 Then
        WScript.Echo Err.Number & ": " & Err.Description
    End If
    
    '438: Object doesn't support this property or method
    '450: Wrong number of arguments or invalid property assignment
    If Err.Number = 438 Or _
       Err.Number = 450 Then
        IsGettable = vbFalse
    Else
        IsGettable = vbTrue
    End If
    
End Function

Function IsSimpleType(obj)
    If (isEmpty(obj) Or isNull(obj)) And (Not IsObject(obj)) And (Not isArray(obj)) Then
        IsSimpleType = vbTrue
    Else
        IsSimpleType = vbFalse
    End If
End Function 

' Decode Type Number to something readable
Function TypeNameFromVarType(typeNr)
    Dim typeDetails
    set typeDetails = CreateObject("Scripting.Dictionary")

    typeDetails.add 0,  "vbEmpty (uninitialized variable)"
    typeDetails.add 1,  "vbNull (value unknown)"
    typeDetails.add 2,  "vbInteger" ' Short?
    typeDetails.add 3,  "vbLong" ' Integer?
    typeDetails.add 4,  "vbSingle"
    typeDetails.add 5,  "vbDouble"
    typeDetails.add 6,  "vbCurrency"
    typeDetails.add 7,  "vbDate"
    typeDetails.add 8,  "vbString"
    typeDetails.add 9,  "vbObject"
    typeDetails.add 10, "Exception"
    typeDetails.add 11, "vbBoolean"
    typeDetails.add 12, "vbVariant"
    typeDetails.add 13, "DataObject"
    typeDetails.add 14, "vbDecimal"
    typeDetails.add 17, "vbByte"
    typeDetails.add 18, "vbChar"
    typeDetails.add 19, "ULong"
    typeDetails.add 20, "Long" ' realy Long?
    typeDetails.add 24, "(void)"
    typeDetails.add 36, "UserDefinedType"

    If typeDetails.Exists(typeNr) Then
        TypeNameFromVarType = typeDetails(typeNr)
    ElseIf typeNr > 8192 Then
        TypeNameFromVarType = "vbArray{" & TypeNameFromVarType(typeNr - 8192) & "}"
    Else
        typeNameFromVarType = "Unknown Type " & typeNr
    End If
End Function

' Some nice example class to demonstrate all possible interfaces.
Class MyClass
    Dim Name_
    Dim Name2_
    Dim Name3_
    Dim Name4_
    Dim dict

    Private Sub Class_Initialize()
        Name_ = "foo"
        Name2_ = "bar"
        Name3_ = "baz"
        Name4_ = "spam"
        Set dict = CreateObject("Scripting.Dictionary")
    End Sub
    
    Private Sub Class_Terminate()
        Set dict = Nothing
    End Sub
        
    Public Property Get Name
        Name = Name_
    End Property

    Public Property Let Name(ByVal Value)
      Name_ = Value
    End Property

    Public Property Let Name2(ByRef Value)
      Set Name2_ = Value
    End Property

    Public Property Get Name3
      Name3 = Name3_
    End Property

    Public Property Set Name3(ByVal Value)
      Set Name3_ = Value
    End Property

    Public Property Get Name4
      Name4 = Name4_
    End Property

    Public Property Set Name4(ByRef Value)
      Set Name4_ = Value
    End Property

    Sub TestSub()
        WScript.Echo "Test"
    End Sub

    Sub TestFunc(message)
        WScript.Echo "Test: " & message
    End Sub

    Sub TestFunc2(ByRef message)
        WScript.Echo "Test: " & message
    End Sub

    Function Add(first, second)
        Add = first + second
    End Function

    Function Substract(ByVal first, ByRef second)
        Add = first - second
    End Function

End Class

Sub testVariableInfo()
    Dim variable
    ' vbEmpty
    Wscript.Echo VariableInfo(variable)

    variable = Null
    Wscript.Echo VariableInfo(variable)

    Set variable = Nothing
    Wscript.Echo VariableInfo(variable)

    Wscript.Echo VariableInfo(Int(23))
    Wscript.Echo VariableInfo(cLng(23))
    Wscript.Echo VariableInfo(2147483647)
    Wscript.Echo VariableInfo(5/4)
    Wscript.Echo VariableInfo(4 * Atn(1)) ' Simplest way to pi, not all inverse functions like arcsin are defined.
    Wscript.Echo VariableInfo(3.4E38)
    Wscript.Echo VariableInfo(CDbl(3.4E38))
    Wscript.Echo VariableInfo(cCur(20.123456))
    Wscript.Echo VariableInfo(now)
    Wscript.Echo VariableInfo("Some Text")
    Wscript.Echo VariableInfo(Err)
    
    Dim MyObject
    Set MyObject = new MyClass
    Wscript.Echo VariableInfo(MyObject)
    Set MyObject = Nothing

    Dim TestAEmpty()
    Wscript.Echo VariableInfo(TestAEmpty)

    ReDim TestA1(17)
    Wscript.Echo VariableInfo(TestA1)

    Dim TestA2(3, 7)
    Wscript.Echo VariableInfo(TestA2)
   
    Dim TestA3
    TestA3 = Array(4, 5, 6)
    Wscript.Echo VariableInfo(TestA3)

    Dim dict
    Set dict = CreateObject("Scripting.Dictionary")
    WScript.Echo VariableInfo(dict)
    Set dict = Nothing
End Sub

testVariableInfo

有关 Typelib 接口(interface)的更多信息，请从 Microsoft KB artivle 224331 获取文档帮助文件
Matthew Curland 在他的书 Advanced Visual Basic 6 的网站上提供下载，作为评估版的不错的程序 Type Library Editor (EditTLBEval.exe)，以及相应的 Documentation
特别是在这种情况下，我真的很喜欢这句话如果你是一个拒绝承认 VB 普遍接受的局限性的 Visual Basic 开发人员，那么这本书绝对适合你。通过泰德帕蒂森。只需在这里用 VBScript 替换 VB。
VBWebProfi gave the hint 用于 TLI，谢谢。不过，制定细节和编写代码需要几个小时的工作；-)