Reflection on COM objects

I'd like to own a "Gestalt Camera". When you photograph an object it wouldn't just save a flat 2-dimensional projection of the object onto an SD card; instead it'd record the "gestalt", an understanding of the whole object and its complete web of relations. This would include a 3d representation of the object from all angles, an essay on its historical significance, a description of the cultural and economic role it plays, detailed internal diagrams showing how it works, a set of hyperlinks to related topics -- and it'll save all this in a wikipedia article.

How would you build such a camera? It's easy! Just take an existing Gestalt Camera, point it at a mirror, and have it take a gestalt photo of its own reflection! Here's the result: https://en.wikipedia.org/wiki/Gestalt_camera. [just a joke: the link doesn't really work.]

That's my roundabout introduction to reflection...

Reflection on .Net objects is done through System.Type and is very easy. For instance, "Dim type = GetType(System.String)" and now you can look at all the members and inheritance hierarchy of the System.String class.

Reflection on COM types is also easy if they have an interop assembly. For instance, add a project reference to the COM Microsoft Speech Library and again do "GetType(SpeechLib.SpVoice)". This lets you reflect on the .Net "Runtime Callable Wrapper" that's in the interop assembly, that was generated from the COM type's type library, and that contains all information that the type library had.

But sometimes you'll be given COM objects that don't have .Net interop assemblies in your code. I ran into this when I wrote a managed plugin for Visual Studio. For reflection here you have to use ITypeInfo instead of System.Type. Here's code to get that ITypeInfo, then dig through it and print out all the members. I'm a novice at COM programming, so I'd welcome suggestions and improvements. (Note: I deliberately didn't attempt to invent some API that would wrap ITypeInfo/TYPEDESC, but it looks ripe for it...)

' REFLECTION ON COM OBJECTS. Lucian Wischik, October 2008.

' (with thanks to Eric Lippert and Sonja Keserovic for their help)

'

' CLR objects let you use .Net reflection on them, via GetType().

' But for COM objects you sometimes have to use the more awkward COM reflection via ITypeInfo/TYPEDESC.

' It all boils down to type libraries...

' * If the COM object's type library has been translated into a managed Runtime Callable Wrapper (RCW)

' then you can reflect on it using .Net reflection. RCWs are generated automatically when you

' add a reference to a COM library.

' * If there's no RCW, then you have to use ITypeInfo to query the type library.

' An ITypeInfo is a pointer to an COM type's information within the type library, and gives

' you the same kind of information as does System.Type. Incidentally, Visual Studio uses the same kind

' of reflection to provide intellisense for COM objects.

' * And if there's no type library at all, then you can't do any reflection on an object

' (unless it happens to implement IDispatchEx -- which we don't go into here).

'

' ITypeInfo -- Represents a class/interface/structure defined in a type library

' TYPEDESC -- Represents atomic types (e.g. Integer), and also compound types

' (e.g. an array whose element type is an ITypeInfo, or a reference

' to an ITypeInfo). Used to describe function parameter types and

' return types.

'

' Here's how to reflect using ITypeInfo...

'

Option Strict On

Imports System.Runtime.InteropServices

Module Module1

    ''' <summary>

    ''' UnmanagedCreateCOM: this is an unmanaged function which calls CoCreateInstance

    ''' to create an instance of CLSID_WebBrowser.

    ''' </summary>

    ''' <returns>returns a new COM object. The caller is expected to AddRef on it.</returns>

    <DllImport("createcom.dll", SetLastError:=False)> _

    Function UnmanagedCreateCOM() As IntPtr

    End Function

    Sub Main()

        ' Reflection on .net objects is straightforward:

        Console.WriteLine("=== REFLECTION ON .NET TYPE VIA .NET REFLECTION ===")

        ReflectOnDotNetType(GetType(System.String))

        ' Reflection on COM objects is easy when they've been added as references...

        ' We have added a COM reference to the Microsoft Speech Library. And now we reflect

        ' on it using normal .net reflection:

        Console.WriteLine("=== REFLECTION ON RCW'D COM TYPE VIA .NET REFLECTION ===")

        ReflectOnDotNetType(GetType(SpeechLib.SpVoice))

        ' But .net reflection gives pointless results on COM objects which lack an interop assembly:

        ' GetObjectForIUnknown just creates a tiny stub RCW for them with a handful of common functions.

        Console.WriteLine("=== REFLECTION ON NON-RCW'D COM TYPE VIA ITYPEINFO REFLECTION ===")

        ReflectOnDotNetType(Marshal.GetObjectForIUnknown(UnmanagedCreateCOM()).GetType())

        ' Instead we have to reflect using ITypeInfo:

        Console.WriteLine("=== REFLECTION ON NON-RCW'D COM TYPE VIA COM REFLECTION ===")

        ReflectOnCOMObjectThroughITypeInfo(Marshal.GetObjectForIUnknown(UnmanagedCreateCOM()))

    End Sub

    ''' <summary>

    ''' ReflectOnDotNetType: reflects on a System.Type using .Net reflection

    ''' </summary>

    ''' <param name="tt">the type to reflect upon</param>

    Sub ReflectOnDotNetType(ByVal tt As System.Type)

        Dim qt As New Queue(Of System.Type)

        qt.Enqueue(tt)

        While qt.Count > 0

            Dim t = qt.Dequeue

            Console.WriteLine("TYPE {0}", t.ToString)

            For Each i In t.GetInterfaces

                Console.WriteLine(" inherits {0}", i.ToString)

                qt.Enqueue(i)

            Next

            For Each m In t.GetMembers

                Console.WriteLine(" member {0}", m.ToString)

            Next

        End While

    End Sub

    ''' <summary>

    ''' IDispatch: this is a managed version of the IDispatch interface

    ''' </summary>

    ''' <remarks>We don't use GetIDsOfNames or Invoke, and so haven't bothered with correct signatures for them.</remarks>

    <ComImport(), Guid("00020400-0000-0000-c000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _

    Interface IDispatch

       Sub GetTypeInfoCount(ByRef pctinfo As UInteger)

        Sub GetTypeInfo(ByVal itinfo As UInteger, ByVal lcid As UInteger, ByRef pptinfo As IntPtr)

        Sub GetIDsOfNames_unused()

        Sub Invoke_unused()

    End Interface

    ''' <summary>

    ''' ReflectOnCOMObjectThroughITypeInfo: given a com object that supports IDispatch, attempts

    ''' to get its ITypeInfo interface (which represents the object's entry in its type-library),

    ''' and reflect on the object through this.

    ''' </summary>

    ''' <param name="com">the com object upon which to reflect</param>

    Sub ReflectOnCOMObjectThroughITypeInfo(ByVal com As Object)

        ' How do we get ITypeInfo for a COM object?

        ' It would be nice to use Marshal.GetITypeInfoForType. But that fails when the com object

        ' doesn't have an interop assembly (e.g. when the com object was created for us

        ' by native code). So instead we have to use IDispatch::GetTypeInfo.

        Dim idisp = CType(com, IDispatch)

        Dim count As UInteger = 0 : idisp.GetTypeInfoCount(count)

        If (count < 1) Then Throw New ArgumentException("No type info", "com")

        Dim _typeinfo As IntPtr : idisp.GetTypeInfo(0, 0, _typeinfo)

        If (_typeinfo = IntPtr.Zero) Then Throw New ArgumentException("No ITypeInfo", "com")

        Dim typeInfo = CType(Marshal.GetTypedObjectForIUnknown(_typeinfo, GetType(ComTypes.ITypeInfo)), ComTypes.ITypeInfo)

        Marshal.Release(_typeinfo) ' to release the AddRef that GetTypeInfo did for us.

        AddTypeInfoToDump(typeInfo)

        While typeInfosToDump.Count > 0

            DumpTypeInfo(typeInfosToDump.Dequeue())

        End While

    End Sub

    ''' <summary>

    ''' DumpType: prints information about an ITypeInfo type to the console -- name, inheritance, members

    ''' </summary>

    ''' <param name="typeInfo">the type to dump</param>

    Sub DumpTypeInfo(ByVal typeInfo As ComTypes.ITypeInfo)

        ' Name:

        Dim typeName = "" : typeInfo.GetDocumentation(-1, typeName, "", 0, "")

        Console.WriteLine("TYPE {0}", typeName)

        ' TypeAttr: contains general information about the type

        Dim pTypeAttr As IntPtr : typeInfo.GetTypeAttr(pTypeAttr)

        Dim typeAttr = CType(Marshal.PtrToStructure(pTypeAttr, GetType(ComTypes.TYPEATTR)), ComTypes.TYPEATTR)

        ' Inheritance:

        For iImplType = 0 To typeAttr.cImplTypes - 1

            Dim href As Integer : typeInfo.GetRefTypeOfImplType(iImplType, href)

            ' "href" is an index into the list of type descriptions within the type library.

            Dim implTypeInfo As ComTypes.ITypeInfo = Nothing : typeInfo.GetRefTypeInfo(href, implTypeInfo)

            ' And GetRefTypeInfo looks up the index to get an ITypeInfo for it.

            Dim implTypeName = "" : implTypeInfo.GetDocumentation(-1, implTypeName, "", 0, "")

            Console.WriteLine(" Implements {0}", implTypeName)

            AddTypeInfoToDump(implTypeInfo)

        Next

        ' Function/Sub/Property members:

        ' Note that property accessors are flattened, e.g. for a property "Fred as Integer"

        ' it will be represented as two members "[Get] Function Fred() As Integer", and "[Put] Sub Fred(Integer)"

        ' Each member is uniquely identified by an integer "MEMID".

        ' This memid is what's used e.g. when invoking the member.

        For iFunc = 0 To typeAttr.cFuncs - 1

            ' FUNCDESC is the key datastructure here:

            Dim pFuncDesc As IntPtr : typeInfo.GetFuncDesc(iFunc, pFuncDesc)

            Dim funcDesc = CType(Marshal.PtrToStructure(pFuncDesc, GetType(ComTypes.FUNCDESC)), ComTypes.FUNCDESC)

            ' Each function notionally has a list of names associated with it. I'll just pick the first.

            Dim names As String() = {""}

            typeInfo.GetNames(funcDesc.memid, names, 1, 0)

            Dim funcName = names(0)

            ' Function formal parameters:

            Dim cParams = funcDesc.cParams

            Dim s = ""

            For iParam = 0 To cParams - 1

                Dim elemDesc = CType(Marshal.PtrToStructure(New IntPtr(funcDesc.lprgelemdescParam.ToInt64 + Marshal.SizeOf(GetType(ComTypes.ELEMDESC)) * iParam), GetType(ComTypes.ELEMDESC)), ComTypes.ELEMDESC)

  If s.Length > 0 Then s &= ", "

                If (elemDesc.desc.paramdesc.wParamFlags And 2) <> 0 Then s &= "out "

                s &= DumpTypeDesc(elemDesc.tdesc, typeInfo)

            Next

            ' And print out the rest of the function's information:

            Dim props = ""

            If (funcDesc.invkind And ComTypes.INVOKEKIND.INVOKE_PROPERTYGET) <> 0 Then props &= "Get "

            If (funcDesc.invkind And ComTypes.INVOKEKIND.INVOKE_PROPERTYPUT) <> 0 Then props &= "Set "

            If (funcDesc.invkind And ComTypes.INVOKEKIND.INVOKE_PROPERTYPUTREF) <> 0 Then props &= "Set "

            Dim isSub = (funcDesc.elemdescFunc.tdesc.vt = VarEnum.VT_VOID)

            s = props & If(isSub, "Sub ", "Function ") & funcName & "(" & s & ")"

            s &= If(isSub, "", " as " & DumpTypeDesc(funcDesc.elemdescFunc.tdesc, typeInfo))

            Console.WriteLine(" " & s)

            typeInfo.ReleaseFuncDesc(pFuncDesc)

        Next

        ' Field members:

        For iVar = 0 To typeAttr.cVars - 1

            Dim pVarDesc As IntPtr : typeInfo.GetVarDesc(iVar, pVarDesc)

            Dim varDesc = CType(Marshal.PtrToStructure(pVarDesc, GetType(ComTypes.VARDESC)), ComTypes.VARDESC)

            Dim names As String() = {""}

            typeInfo.GetNames(varDesc.memid, names, 1, 0)

            Dim varName = names(0)

            Console.WriteLine(" Dim {0} As {1}", varName, DumpTypeDesc(varDesc.elemdescVar.tdesc, typeInfo))

        Next

        Console.WriteLine()

    End Sub

    ''' <summary>

    ''' DumpTypeDesc: given a TYPEDESC, dumps it out into a string e.g. "Ref Int" or

    ''' "Array of MyTypeInfo". Also calls AddTypeInfoToDump for every ITypeInfo encountered.

    ''' </summary>

    ''' <param name="tdesc">the TYPEDESC to dump</param>

    ''' <param name="context">the ITypeInfo that contained this TYPEDESC, for context</param>

    ''' <returns>a string representation of the TYPEDESC</returns>

    Function DumpTypeDesc(ByVal tdesc As ComTypes.TYPEDESC, ByVal context As ComTypes.ITypeInfo) As String

        Dim vt = CType(tdesc.vt, VarEnum)

        Select Case vt

            Case VarEnum.VT_PTR

                Dim tdesc2 = CType(Marshal.PtrToStructure(tdesc.lpValue, GetType(ComTypes.TYPEDESC)), ComTypes.TYPEDESC)

                Return "Ref " & DumpTypeDesc(tdesc2, context)

            Case VarEnum.VT_USERDEFINED

                Dim href = tdesc.lpValue.ToInt32()

                Dim refTypeInfo As ComTypes.ITypeInfo = Nothing : context.GetRefTypeInfo(href, refTypeInfo)

                AddTypeInfoToDump(refTypeInfo)

                Dim refTypeName = "" : refTypeInfo.GetDocumentation(-1, refTypeName, "", 0, "")

                Return refTypeName

            Case VarEnum.VT_CARRAY

                Dim tdesc2 = CType(Marshal.PtrToStructure(tdesc.lpValue, GetType(ComTypes.TYPEDESC)), ComTypes.TYPEDESC)

                Return "Array of " & DumpTypeDesc(tdesc2, context)

                ' lpValue is actually an ARRAYDESC structure, which also has information on the array dimensions,

                ' but alas .Net doesn't predefine ARRAYDESC.

            Case VarEnum.VT_VOID ' e.g. IUnknown::QueryInterface(Ref GUID, out Ref Ref Void)

                Return "Void"

            Case VarEnum.VT_VARIANT

                Return "Object"

            Case VarEnum.VT_UNKNOWN

                Return "IUnknown*"

            Case VarEnum.VT_BSTR

                Return "String"

            Case VarEnum.VT_LPWSTR

                Return "wchar*"

            Case VarEnum.VT_LPSTR

                Return "char*"

            Case VarEnum.VT_HRESULT

                Return "HResult"

            Case VarEnum.VT_BOOL

                Return "Bool"

            Case VarEnum.VT_I1

                Return "SByte"

            Case VarEnum.VT_UI1

                Return "Byte"

            Case VarEnum.VT_I2

                Return "Short"

            Case VarEnum.VT_UI2

                Return "UShort"

            Case VarEnum.VT_I4, VarEnum.VT_INT ' I don't know the difference

                Return "Integer"

            Case VarEnum.VT_UI4, VarEnum.VT_UINT ' I don't know the difference

                Return "UInteger"

            Case VarEnum.VT_I8

                Return "Long"

            Case VarEnum.VT_UI8

                Return "ULong"

            Case Else

                ' There are many other VT_s that I haven't special-cased yet.

                ' That's just because I haven't encountered them yet in my test-cases.

                Return vt.ToString()

        End Select

    End Function

    Dim typeInfosToDump As New Queue(Of ComTypes.ITypeInfo)

    Dim typeInfosDumped As New HashSet(Of String)

    '

    Sub AddTypeInfoToDump(ByVal typeInfo As ComTypes.ITypeInfo)

        Dim typeName = "" : typeInfo.GetDocumentation(-1, typeName, "", 0, "")

        If typeInfosDumped.Contains(typeName) Then Return

        typeInfosToDump.Enqueue(typeInfo)

        typeInfosDumped.Add(typeName)

    End Sub

End Module