Interop Problem with COM IDataObject and TOM Paste
I have been trying to access the text object model (TOM) using the RichEdit control in NET. So far I have successfully implemented most methods of the ITextDocument and ITextRange interfaces. I am now trying to implement the Paste method of the ITextRange interface which is defined as follows:
STDMETHODIMP Paste(VARIANT *pVar, long Format);
Where pVar is a pointer to the IDataObject to paste, but the contents of the clipboard are used if any of the following are true:
pVar is null
pVar punkVal is null
pVar is not VT_UNKNOWN
pVar punkVal does not return an IDataObject when queried for one
I’ve translated this in my ITextRange in VB.Net as follows:
Function Paste(ByRef pVar As IntPtr, ByVal Format As Integer) As Integer
I then tried to build a DLL that implements the IDataObject interface as follows:
Option Explicit On
Option Strict On
Imports System.Drawing
Imports System.Runtime.InteropServices
Namespace OLECom
<ComVisible(True)> _
<CLSCompliant(False)> _
<Guid("0000010e-0000-0000-C000-000000000046")> _
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IDataObject
<PreserveSig()> Function GetData(ByRef format As OLECom.FormatEtc, ByRef medium As OLECom.StgMedium) As Integer
<PreserveSig()> Function GetDataHere(ByRef format As OLECom.FormatEtc, ByRef medium As OLECom.StgMedium) As Integer
<PreserveSig()> Function QueryGetData(ByRef format As OLECom.FormatEtc) As Integer
<PreserveSig()> Function GetCanonicalFormatEtc(ByRef formatIn As FormatEtc, ByRef formatOut As OLECom.FormatEtc) As Integer
<PreserveSig()> Function SetData(ByRef formatIn As OLECom.FormatEtc, ByRef medium As OLECom.StgMedium, <MarshalAs(UnmanagedType.Bool)> ByVal release As Boolean) As Integer
<PreserveSig()> Function EnumFormatEtc(ByVal direction As OLECom.DataDir) As OLECom.IEnumFormatEtc
' In the following functions references to interfaces etc eg IAdvise have been reset to pointers
<PreserveSig()> Function DAdvise(ByRef pFormatetc As OLECom.FormatEtc, ByVal advf As IntPtr, ByVal adviseSink As IntPtr, ByRef connection As Integer) As Integer
<PreserveSig()> Function DUnadvise(ByVal connection As Integer) As Integer
<PreserveSig()> Function EnumDAdvise(ByRef enumAdvise As IntPtr) As Integer
End Interface
<Guid("00000103-0000-0000-C000-000000000046")> _
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IEnumFormatEtc
<PreserveSig()> Function [Next](<MarshalAs(UnmanagedType.U4)> ByVal celt As Integer, <Out(), MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=0)> ByRef rgelt As OLECom.FormatEtc(), <Out(), MarshalAs(UnmanagedType.LPArray)> ByRef pceltFetched() As Integer) As Integer
<PreserveSig()> Function Skip(<MarshalAs(UnmanagedType.U4)> ByVal celt As Integer) As Integer
<PreserveSig()> Function Reset() As Integer
Sub Clone(<Out()> ByRef newEnum As IEnumFormatEtc)
End Interface
<CLSCompliant(False)> _
<StructLayout(LayoutKind.Sequential)> _
Public Structure FormatEtc
Public cfFormat As OLECom.ClipboardFormats
Public ptd As IntPtr
Public dwAspect As OLECom.DVAspect
Public lindex As Integer
Public tymed As OLECom.Tymed
End Structure
<CLSCompliant(False)> _
<StructLayout(LayoutKind.Sequential)> _
Public Structure StgMedium
Public tymed As OLECom.Tymed
Public unionmember As IntPtr
<MarshalAs(UnmanagedType.IUnknown)> Public pUnkForRelease As Object
End Structure
<CLSCompliant(False)> _
<Flags()> _
Public Enum DVAspect As UInteger
DVAspect_Content = 1
DVAspect_Thumbnail = 2
DVAspect_Icon = 4
DVAspect_Docprint = 8
End Enum
<CLSCompliant(False)> _
<Flags()> _
Public Enum Tymed As UInteger
Tymed_Null = 0
Tymed_HGlobal = 1
Tymed_File = 2
Tymed_IStream = 4
Tymed_IStorage = 8
Tymed_GDI = 16
Tymed_MFPict = 32
Tymed_Enhmf = 64
End Enum
Public Enum ClipboardFormats As Short
CF_Text = 1
CF_Bitmap = 2
CF_MetafilePict = 3
CF_Sylk = 4
CF_Dif = 5
CF_Tiff = 6
CF_OEMText = 7
CF_Dib = 8
CF_Palette = 9
CF_Pendata = 10
CF_Riff = 11
CF_Wave = 12
CF_UnicodeText = 13
CF_EnhMetafile = 14
CF_HDrop = 15
CF_Locale = 16
CF_DibV5 = 17
End Enum
Public Enum DataDir As Integer
DataDir_Get = 1
DataDir_Set = 2
End Enum
<Guid("959966E1-55C6-4b08-AE89-F2E4CE10BCF6")> _
<CLSCompliant(False)> _
<ClassInterface(ClassInterfaceType.None)> _
Public Class ExDataObject
Implements IDataObject
Private Const E_NOTIMPL As Integer = &H80000001
Private Const OLE_E_ADVISENOTSUPPORTED As Integer = &H80040003
Private Const DV_E_FORMATETC As Integer = &H80040064
Private Const S_OK As Integer = &H0
Private mFormatEtc(0) As OLECom.FormatEtc
Private mNumberFormats As Integer = 1
Private mBitmap As Bitmap
Private Declare Auto Function SHCreateStdEnumFmtEtc Lib "shell32.dll" (ByVal cfmt As UInt32, ByRef afmt() As FormatEtc, ByRef ppenumFormatEtc As IEnumFormatEtc) As Integer
Public Sub New(ByVal FileName As String)
mBitmap = New Bitmap(FileName)
With mFormatEtc(0)
.dwAspect = OLECom.DVAspect.DVAspect_Content
.tymed = OLECom.Tymed.Tymed_GDI
.cfFormat = OLECom.ClipboardFormats.CF_Bitmap
.lindex = -1
.ptd = Nothing
End With
End Sub
#Region "IDataObject Implementation"
Public Function DAdvise(ByRef pFormatetc As FormatEtc, ByVal advf As IntPtr, ByVal adviseSink As IntPtr, ByRef connection As Integer) As Integer _
Implements IDataObject.DAdvise
Return OLE_E_ADVISENOTSUPPORTED
End Function
Public Function DUnadvise(ByVal connection As Integer) As Integer _
Implements IDataObject.DUnadvise
Return OLE_E_ADVISENOTSUPPORTED
End Function
Public Function EnumDAdvise(ByRef enumAdvise As IntPtr) As Integer _
Implements IDataObject.EnumDAdvise
Return OLE_E_ADVISENOTSUPPORTED
End Function
Public Function EnumFormatEtc(ByVal direction As DataDir) As OLECom.IEnumFormatEtc _
Implements IDataObject.EnumFormatEtc
Dim pReturn As OLECom.IEnumFormatEtc = Nothing
Dim pResult As Integer
If direction = DataDir.DataDir_Get Then
pResult = SHCreateStdEnumFmtEtc(CUInt(mNumberFormats), mFormatEtc, pReturn)
Return pReturn
Else
Marshal.ThrowExceptionForHR(E_NOTIMPL)
Return Nothing
End If
End Function
Public Function GetCanonicalFormatEtc(ByRef formatIn As OLECom.FormatEtc, ByRef formatOut As OLECom.FormatEtc) As Integer _
Implements IDataObject.GetCanonicalFormatEtc
formatOut.ptd = IntPtr.Zero
Return E_NOTIMPL
End Function
Public Function GetData(ByRef format As OLECom.FormatEtc, ByRef medium As OLECom.StgMedium) As Integer _
Implements IDataObject.GetData
With medium
.unionmember = mBitmap.GetHbitmap
.tymed = Tymed.Tymed_GDI
.pUnkForRelease = 0
End With
End Function
Public Function GetDataHere(ByRef format As OLECom.FormatEtc, ByRef medium As OLECom.StgMedium) As Integer _
Implements IDataObject.GetDataHere
Return E_NOTIMPL
End Function
Public Function QueryGetData(ByRef format As OLECom.FormatEtc) As Integer _
Implements IDataObject.QueryGetData
If (mFormatEtc(0).tymed = format.tymed) AndAlso (mFormatEtc(0).cfFormat = format.cfFormat) AndAlso (mFormatEtc(0).dwAspect = format.dwAspect) Then
Return S_OK
Else
Return DV_E_FORMATETC
End If
End Function
Public Function SetData(ByRef formatIn As OLECom.FormatEtc, ByRef medium As OLECom.StgMedium, ByVal release As Boolean) As Integer _
Implements IDataObject.SetData
Return E_NOTIMPL
End Function
#End Region
End Class
End Namespace
I then signed this assembly, compiled it and registered it along with craeting a type library and regsitering the library as well. Then I transferred it to the global assembly cache
and made references to it from my test project. In my test project I tried to call the ITextRange.Paste method as follows:
Public Overloads Sub Paste(ByVal FileName As String, Optional ByVal Format As Integer = 0)
Dim pIDO As New OleCOM.OLECom.ExDataObject(FileName)
Dim pPtr As IntPtr = Marshal.GetComInterfaceForObject(pIDO, GetType(OleCOM.OLECom.IDataObject))
TextRange.Paste(pPtr, Format)
Etc
End Sub
If there is anything on the shared clipboard, that gets pasted instead of the supplied bitmap ("C:\Test.bmp"). If there is nothing on the clipboard, then I get an OutOfMemoryException which is one of the possible return values from this function.
Finally, my question is - Where is my mistake or mistakes. I've implemented similar functionality in a VB6 program and it works perfectly so I presume it has something to do with marshalling and interop. Any help would be greatly appreciated since I've been banging my head against the wall for several days now.
Regards,
John.
