[原文链接]：Reflection on COM objects
我希望拥有一台这样的“完全形态”照样机, 当你拍摄一个物体(object)时，它不仅仅把二维图像存储在SD卡上，而是把物体记录在“完全形态”这个“存储卡”上，并且了解这个物体和其所构成的所有关系。这样会包括这个物体各个角度的三维图像，关于其历史意义的短文，对其文化和经济中所扮演的角色的描述，详尽的内部图表展现了物体是怎样工作，以及一系列的超链接指向与这个物体有关的主体–并且所有的这些都会被保存在维基百科中。
你准备如何创建这样一个相机呢？
以上这些是为了引出反射这个主题…
.NET 对象上的反射通过 System.Type 完成，非常简单。比如"Dim type = GetType(System.string)"，现在您可以查看所有成员和 System.String 类的继承层次结构。
如果我们有一个(.Net) interop 程序集，反射COM类型也同样简单。比如，一个project 添加COM引用Microsoft Speech Library，然后可以进行反射做”GetType(SpeechLib.SpVoice)”。其实这样是对(.Net)interop程序集中“Runtime Callable Wrapper”的反射，“Runtime Callable Wrapper”是从COM类型的类库得到的，包括了这个COM类库所有的信息。[译注：Runtime Callble Wrapper(RCW)，我们可以生成一个RCW，通过RCW，.Net用户就可以使用.Net对象而不是COM组件，为了实现传统的COM程序与.NET程序之间的相互调用，.NET提供了包装类RCW(Runtime Callable Wrapper)和CCW(COM Callable Wrapper)。每当一个.NET客户程序调用一个COM对象的方法时就会创建一个RCW对象，每当一个COM客户程序调用一个.NET对象的方法时就会创建一个CCW对象。
不过有时，你只有COM组件而没有.Net interop程序集。在我为Visual Studio写托管插件时就遇过这样的情况。对于此处反射必须使用ITypeInfo而不是 System.Type。 以下是代码以获取该 ITypeInfo、然后输出所有成员。我是在 COM 编程的初学者，欢迎所有的建议和改进。（注意：我特意不尝试创建包装 ITypeInfo / TYPEDESC 的 API，虽然那样是比较成熟的） [译注:一般情况下，.Net调用COM组件，我们都会让Visual Studio生成Interop 程序集，这样依然可以用一般的反射，但是让vs.net自动生成一个包装过的.net类库。这种方法虽然方便，但是有很明显的缺点，最致命的就是开发的机器上安装的Com对象的版本比客户机器上安装的高，开发的程序无法正确的运行。
' REFLECTION ON COM OBJECTS. Lucian Wischik, October 2008.
' (with thanks to Eric Lippert and Sonja Keserovic for their help)
'
' CLR允许你通过GetType()进行反射类型
' 对于COM组件，有时你需要通过ITypeInfo/TYPEDESC来进行反射
' * 如果COM组件已经被转换成一个托管的RCW
' 这时可以用RCW进行反射
' * 如果没有RCW可用，还是需要通过ITypeInfo/TYPEDESC
' ItypeInfo是指向COM组件的指针，可以和System.Type得到一样的信息，Visual Studio对于COM的智能化提示，正是使用这个来反射COM组件
' * 如果没有类库，我们对组件不能做反射
'
' ITypeInfo – 对class/interface/structure的引用
' TYPEDESC – 表示一些原型（比如，Integer）,或者一些复合类型
' 下面显示了怎么使用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()
' 对.net类型的反射最直接:
Console.WriteLine("=== REFLECTION ON .NET TYPE VIA .NET REFLECTION ===")
ReflectOnDotNetType(GetType(System.String))
' 如果将COM组件加到引用中，反射也是很简单的
' 我们将一个COM组件加到引用中，然后反射
' 和普通的.net类型一样使用反射:
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())
' 这样我们需要使用ITypeInfo来代替：
Console.WriteLine("=== REFLECTION ON NON-RCW'D COM TYPE VIA COM REFLECTION ===")
ReflectOnCOMObjectThroughITypeInfo(Marshal.GetObjectForIUnknown(UnmanagedCreateCOM()))
End Sub
''' <summary>
''' ReflectOnDotNetType: 反射.net 类型
''' </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: 托管Idispatch 接口
''' </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: 一个支持Idispatch and attempts 的COM组件
''' 得到它的ItypeInfor 接口
''' 通过这个方法反射COM类型.
''' </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成员:
' 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 是这里的主要结构:
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 参数:
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
' 输出函数的其他信息:
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 成员:
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
Return "Integer"
Case VarEnum.VT_UI4, VarEnum.VT_UINT
Return "UInteger"
Case VarEnum.VT_I8
Return "Long"
Case VarEnum.VT_UI8
Return "ULong"
Case Else
' 这里还有其他类型，我没有在这里列出
' 大家可以根据需要将其他的列出来.
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
EndModule
打印 | 张贴于 2008-12-17 17:27:49 | Tag:VB Team Blog Visual Basic
留言反馈