I've got an update for the fix which provides a specific EqualityComparer for the value type TYPELIBATTR. The default generic dictionary was using ObjectEqualityComparer<TYPELIBATTR> which was very expensive because of the reflection and boxing involved when trying to equality compare this type generically. This reduced the dynamic memory allocation overhead from about 100Mb to about 50Mb in a test I ran yesterday. Without any fixes at all my test yesterday used a whopping 4.5Gb of dynamic memory. When not using proxies at all we are seeing only 16Mb of dynamic memory in this test case.
I'm working on one further optimization which is to be able to detach the internal event subscriptions within NamedRanges and perhaps ListObjects when large changes are occuring on a worksheet such as ListObject binding/unbinding. This code yet again requires a bit of reflection hell. However the aforementioned 50Mb dynamic memory usage is reduced to 27Mb when detaching NamedRange event subscriptions when binding/unbinding to a ListObject on the same worksheet as the NamedRanges (about 20 named ranges, the list object is 50rows by 52 cols (cols are showing weekly data, like a psuedo editable pivot table)). 27Mb is getting close to the 16Mb figure without proxies and consequently the visible performance also looks similar.
The updated code with the new dictionary equality comparer is below.
Imports System.Reflection
Imports System.Runtime.InteropServices.ComTypes
Public Class XLProxyFixer
Private Sub New()
End Sub
Public Shared Sub FixProxies()
Dim oTypeLibAttr As TYPELIBATTR = New TYPELIBATTR()
oTypeLibAttr.guid = New Guid("00020813-0000-0000-c000-000000000046")
oTypeLibAttr.wMajorVerNum = 1
oTypeLibAttr.wMinorVerNum = 5
oTypeLibAttr.syskind = SYSKIND.SYS_WIN32
oTypeLibAttr.wLibFlags = LIBFLAGS.LIBFLAG_FHASDISKIMAGE
oTypeLibAttr.lcid = 0
Dim oPiaAssembly As Assembly = GetType(Microsoft.Office.Interop.Excel.Range).Assembly
Dim oAssembly As Assembly = GetType(Microsoft.Office.Tools.Excel.NamedRange).Assembly
Dim oType As Type = oAssembly.GetType("Microsoft.Office.Tools.Excel.TypeResolver", True, True)
Dim oTypeResolver As Object = Activator.CreateInstance(oType, BindingFlags.CreateInstance Or BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public, Nothing, New Object() { oPiaAssembly }, System.Globalization.CultureInfo.InvariantCulture)
Dim oCached As IDictionary = CType(oType.InvokeMember("cached", BindingFlags.GetField Or BindingFlags.Static Or BindingFlags.NonPublic Or BindingFlags.Public, Nothing, Nothing, Nothing), IDictionary)
If Not oCached.Contains(oTypeLibAttr) Then
Dim oComparer As TypeLibAttrEqualityComparer = New TypeLibAttrEqualityComparer()
CType(oCached, Object).GetType().InvokeMember("comparer", BindingFlags.SetField Or BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public, Nothing, oCached, New Object() {oComparer} )
oCached.Add(oTypeLibAttr, oTypeResolver)
End If
End Sub
End Class
Friend Class TypeLibAttrEqualityComparer
Inherits EqualityComparer(Of TYPELIBATTR)
Public Sub New()
End Sub
Public Overrides Function Equals(ByVal obj As Object) As Boolean
Dim oComparer As TypeLibAttrEqualityComparer = TryCast(obj, TypeLibAttrEqualityComparer)
Return (Not oComparer Is Nothing)
End Function
Public Overrides Function Equals(ByVal x As TYPELIBATTR, ByVal y As TYPELIBATTR) As Boolean
Return (x.guid = y.guid) And (x.lcid = y.lcid) And (x.syskind = y.syskind) And (x.wLibFlags = y.wLibFlags) And (x.wMajorVerNum = y.wMajorVerNum) And (x.wMinorVerNum = y.wMinorVerNum)
End Function
Public Overrides Function GetHashCode() As Integer
Return MyBase.GetType().Name.GetHashCode()
End Function
Public Overrides Function GetHashCode(ByVal oTypeLibAttr As TYPELIBATTR) As Integer
Return oTypeLibAttr.guid.GetHashCode()
End Function
End Class
| 
index > Visual Studio Tools for Office > Fix for VSTO 2005 performance problems when using transparent pro...