diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml b/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml
new file mode 100644
index 0000000000000..0b03152865f96
--- /dev/null
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb
index 60b60d57f03ce..d2c97225bf881 100644
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb
@@ -343,6 +343,10 @@ GetSpecialValue:
End Function
Friend Shared Function VBFriendlyName(ByVal typ As System.Type, ByVal o As Object) As String
+ If typ.IsCOMObject AndAlso (typ.FullName = "System.__ComObject") Then
+ Return TypeNameOfCOMObject(o, False)
+ End If
+
Return VBFriendlyNameOfType(typ)
End Function
diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb
index 3d54d11a9826e..ec2405ea0089d 100644
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb
@@ -110,7 +110,15 @@ Namespace Microsoft.VisualBasic.CompilerServices
End If
typ = Expression.GetType()
+#If TARGET_WINDOWS Then
+ If (typ.IsCOMObject AndAlso (System.String.CompareOrdinal(typ.Name, COMObjectName) = 0)) Then
+ Result = TypeNameOfCOMObject(Expression, True)
+ Else
+ Result = VBFriendlyNameOfType(typ)
+ End If
+#Else
Result = VBFriendlyNameOfType(typ)
+#End If
Return Result
End Function
diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb
index 551571b3dd176..e021b542552b7 100644
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb
@@ -60,6 +60,249 @@ Namespace Microsoft.VisualBasic.CompilerServices
Friend Shared Function GetLogicalDrives() As Integer
End Function
+ Public Const LCID_US_ENGLISH As Integer = &H409
+
+
+ Public Enum tagSYSKIND
+ SYS_WIN16 = 0
+ SYS_MAC = 2
+ End Enum
+
+ ' REVIEW : - c# version was class, does it make a difference?
+ ' [StructLayout(LayoutKind.Sequential)]
+ ' Public class tagTLIBATTR {
+
+ Public Structure tagTLIBATTR
+ Public guid As Guid
+ Public lcid As Integer
+ Public syskind As tagSYSKIND
+ Public wMajorVerNum As Short
+ Public wMinorVerNum As Short
+ Public wLibFlags As Short
+ End Structure
+
+
+ Public Interface ITypeComp
+
+
+ Sub RemoteBind(
+ <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szName As String,
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+ <[In](), MarshalAs(UnmanagedType.U2)> ByVal wFlags As Short,
+ ByVal ppTInfo As ITypeInfo(),
+ ByVal pDescKind As ComTypes.DESCKIND(),
+ ByVal ppFuncDesc As ComTypes.FUNCDESC(),
+ ByVal ppVarDesc As ComTypes.VARDESC(),
+ ByVal ppTypeComp As ITypeComp(),
+ ByVal pDummy As Integer())
+
+ Sub RemoteBindType(
+ <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szName As String,
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+ ByVal ppTInfo As ITypeInfo())
+ End Interface
+
+
+ Public Interface IDispatch
+
+
+
+ Function GetTypeInfoCount() As Integer
+
+
+ Function GetTypeInfo(
+ <[In]()> ByVal index As Integer,
+ <[In]()> ByVal lcid As Integer,
+ <[Out](), MarshalAs(UnmanagedType.Interface)> ByRef pTypeInfo As ITypeInfo) As Integer
+
+ ' WARNING : - This api NOT COMPLETELY DEFINED, DO NOT CALL!
+
+ Function GetIDsOfNames() As Integer
+
+ ' WARNING : - This api NOT COMPLETELY DEFINED, DO NOT CALL!
+
+ Function Invoke() As Integer
+ End Interface
+
+
+ Public Interface ITypeInfo
+
+ Function GetTypeAttr(
+ ByRef pTypeAttr As IntPtr) As Integer
+
+
+ Function GetTypeComp(
+ ByRef pTComp As ITypeComp) As Integer
+
+
+
+ Function GetFuncDesc(
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+ ByRef pFuncDesc As IntPtr) As Integer
+
+
+ Function GetVarDesc(
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+ ByRef pVarDesc As IntPtr) As Integer
+
+
+ Function GetNames(
+ <[In]()> ByVal memid As Integer,
+ ByVal rgBstrNames As String(),
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal cMaxNames As Integer,
+ ByRef cNames As Integer) As Integer
+
+
+
+ Function GetRefTypeOfImplType(
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+ ByRef pRefType As Integer) As Integer
+
+
+
+ Function GetImplTypeFlags(
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+ ByVal pImplTypeFlags As Integer) As Integer
+
+
+ Function GetIDsOfNames(
+ <[In]()> ByVal rgszNames As IntPtr,
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal cNames As Integer,
+ ByRef pMemId As IntPtr) As Integer
+
+
+
+ Function Invoke() As Integer
+
+
+ Function GetDocumentation(
+ <[In]()> ByVal memid As Integer,
+ ByRef pBstrName As String,
+ ByRef pBstrDocString As String,
+ ByRef pdwHelpContext As Integer,
+ ByRef pBstrHelpFile As String) As Integer
+
+
+
+ Function GetDllEntry(
+ <[In]()> ByVal memid As Integer,
+ <[In]()> ByVal invkind As ComTypes.INVOKEKIND,
+ ByVal pBstrDllName As String,
+ ByVal pBstrName As String,
+ ByVal pwOrdinal As Short) As Integer
+
+
+ Function GetRefTypeInfo(
+ <[In]()> ByVal hreftype As IntPtr,
+ ByRef pTypeInfo As ITypeInfo) As Integer
+
+
+
+ Function AddressOfMember() As Integer
+
+
+
+ Function CreateInstance(
+ <[In]()> ByRef pUnkOuter As IntPtr,
+ <[In]()> ByRef riid As Guid,
+ ByVal ppvObj As Object) As Integer
+
+
+
+ Function GetMops(
+ <[In]()> ByVal memid As Integer,
+ ByVal pBstrMops As String) As Integer
+
+
+ Function GetContainingTypeLib(
+ ByVal ppTLib As ITypeLib(),
+ ByVal pIndex As Integer()) As Integer
+
+
+ Sub ReleaseTypeAttr(ByVal typeAttr As IntPtr)
+
+
+ Sub ReleaseFuncDesc(ByVal funcDesc As IntPtr)
+
+
+ Sub ReleaseVarDesc(ByVal varDesc As IntPtr)
+ End Interface
+
+
+ Public Interface IProvideClassInfo
+ Function GetClassInfo() As ITypeInfo
+ End Interface
+
+
+ Public Interface ITypeLib
+
+ Sub RemoteGetTypeInfoCount(
+ ByVal pcTInfo As Integer())
+
+ Sub GetTypeInfo(
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+ ByVal ppTInfo As ITypeInfo())
+
+ Sub GetTypeInfoType(
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+ ByVal pTKind As ComTypes.TYPEKIND())
+
+ Sub GetTypeInfoOfGuid(
+ <[In]()> ByRef guid As Guid,
+ ByVal ppTInfo As ITypeInfo())
+
+
+ Sub RemoteGetLibAttr(
+ ByVal ppTLibAttr As tagTLIBATTR(),
+ ByVal pDummy As Integer())
+
+ Sub GetTypeComp(
+ ByVal ppTComp As ITypeComp())
+
+
+ Sub RemoteGetDocumentation(
+ ByVal index As Integer,
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal refPtrFlags As Integer,
+ ByVal pBstrName As String(),
+ ByVal pBstrDocString As String(),
+ ByVal pdwHelpContext As Integer(),
+ ByVal pBstrHelpFile As String())
+
+
+ Sub RemoteIsName(
+ <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szNameBuf As String,
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+ ByVal pfName As IntPtr(),
+ ByVal pBstrLibName As String())
+
+
+ Sub RemoteFindName(
+ <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szNameBuf As String,
+ <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+ ByVal ppTInfo As ITypeInfo(),
+ ByVal rgMemId As Integer(),
+ <[In](), Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pcFound As Short(),
+ ByVal pBstrLibName As String())
+
+
+ Sub LocalReleaseTLibAttr()
+ End Interface
+
'''
''' Frees memory allocated from the local heap. i.e. frees memory allocated
''' by LocalAlloc or LocalReAlloc.n
diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb
index ad351998d9ef2..4c85fc225ead7 100644
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb
@@ -156,6 +156,64 @@ Namespace Microsoft.VisualBasic
End Function
+ Friend Function TypeNameOfCOMObject(ByVal VarName As Object, ByVal bThrowException As Boolean) As String
+
+ Dim Result As String = COMObjectName
+
+#If TARGET_WINDOWS Then
+ Dim pTypeInfo As UnsafeNativeMethods.ITypeInfo = Nothing
+ Dim hr As Integer
+ Dim ClassName As String = Nothing
+ Dim DocString As String = Nothing
+ Dim HelpContext As Integer
+ Dim HelpFile As String = Nothing
+
+
+ Do
+ Dim pProvideClassInfo As UnsafeNativeMethods.IProvideClassInfo = TryCast(VarName, UnsafeNativeMethods.IProvideClassInfo)
+
+ If pProvideClassInfo IsNot Nothing Then
+ Try
+ pTypeInfo = pProvideClassInfo.GetClassInfo()
+ hr = pTypeInfo.GetDocumentation(-1, ClassName, DocString, HelpContext, HelpFile)
+ If hr >= 0 Then
+ Result = ClassName
+ Exit Do
+ End If
+ pTypeInfo = Nothing
+ Catch ex As StackOverflowException
+ Throw ex
+ Catch ex As OutOfMemoryException
+ Throw ex
+ Catch
+ 'Ignore the error
+ End Try
+ End If
+
+ Dim pDispatch As UnsafeNativeMethods.IDispatch = TryCast(VarName, UnsafeNativeMethods.IDispatch)
+
+ If pDispatch IsNot Nothing Then
+ ' Try using IDispatch
+ hr = pDispatch.GetTypeInfo(0, UnsafeNativeMethods.LCID_US_ENGLISH, pTypeInfo)
+ If hr >= 0 Then
+ hr = pTypeInfo.GetDocumentation(-1, ClassName, DocString, HelpContext, HelpFile)
+ If hr >= 0 Then
+ Result = ClassName
+ Exit Do
+ End If
+ End If
+ End If
+
+ Loop While (False)
+#End If
+
+
+ If Result.Chars(0) = "_"c Then
+ Result = Result.Substring(1)
+ End If
+
+ Return Result
+ End Function
Public Function QBColor(ByVal Color As Integer) As Integer
If (Color And &HFFF0I) <> 0 Then
@@ -498,6 +556,27 @@ UnmangleName:
Dim Result As String = COMObjectName
+#If TARGET_WINDOWS Then
+ Dim pTypeInfo As UnsafeNativeMethods.ITypeInfo = Nothing
+ Dim hr As Integer
+ Dim ClassName As String = Nothing
+ Dim DocString As String = Nothing
+ Dim HelpContext As Integer
+ Dim HelpFile As String = Nothing
+
+ Dim pDispatch As UnsafeNativeMethods.IDispatch = TryCast(VarName, UnsafeNativeMethods.IDispatch)
+
+ If pDispatch IsNot Nothing Then
+ hr = pDispatch.GetTypeInfo(0, UnsafeNativeMethods.LCID_US_ENGLISH, pTypeInfo)
+ If hr >= 0 Then
+ hr = pTypeInfo.GetDocumentation(-1, ClassName, DocString, HelpContext, HelpFile)
+ If hr >= 0 Then
+ Result = ClassName
+ End If
+ End If
+ End If
+#End If
+
If Result.Chars(0) = "_"c Then
Result = Result.Substring(1)
End If
diff --git a/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs b/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs
index 56b85919578d2..c2a930cf9d00d 100644
--- a/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs
+++ b/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs
@@ -106,6 +106,16 @@ public void TypeName(object expression, string expected)
Assert.Equal(expected, Versioned.TypeName(expression));
}
+ [ConditionalTheory(typeof(PlatformDetection), nameof(PlatformDetection.IsWindows), nameof(PlatformDetection.IsNotWindowsNanoServer))]
+ [MemberData(nameof(TypeName_ComObject_TestData))]
+ [SkipOnMono("COM Interop not supported on Mono")]
+ public void TypeName_ComObject(string progId, string expected)
+ {
+ Type type = Type.GetTypeFromProgID(progId, true);
+ object expression = Activator.CreateInstance(type);
+ Assert.Equal(expected, Versioned.TypeName(expression));
+ }
+
public static IEnumerable TypeName_TestData()
{
yield return new object[] { null, "Nothing" };
@@ -132,6 +142,13 @@ public static IEnumerable TypeName_TestData()
yield return new object[] { (int?)0, "Integer" };
}
+ public static IEnumerable TypeName_ComObject_TestData()
+ {
+ yield return new object[] { "ADODB.Stream", "Stream" };
+ yield return new object[] { "MSXML2.DOMDocument", "DOMDocument" };
+ yield return new object[] { "Scripting.Dictionary", "Dictionary" };
+ }
+
[Theory]
[InlineData(null, null)]
[InlineData("System.Object", "Object")]