Results 1 to 22 of 22

Thread: can we create a lightweight com IDataObject ?

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    can we create a lightweight com IDataObject ?

    Hi,

    I have been experimenting recently with lighweight objects and I have partially succeded in some areas.

    One of those success areas was passing the lightweight object to the RegisterDragDrop API in its second argument in order to be able to intercept the IDropTarget:: Drop "event"

    Code:
    RegisterDragDrop hwnd, VarPtr(pVtable)
    Now, I am trying to do similar with the IDataObject in order to intercept the IDataObject Methods

    Below is the code I came up with so far but my logic is clearly flawed as none of the codes in the lightweight object functions are raised when I run the code and follow it by performing various copy\paste operations via the UI.

    Basically, I am doing the following :
    1- Get a pointer to the IDataObject via the SHCreateFileDataObject API
    2- Create the lightweight IDataObject (vtable structure).
    3- Use Copymemory API to copy the address of the IDataObject (the one I got via SHCreateFileDataObject ) to the new vtable address.... This should make the lightweight interface point to the actual dataobject.


    Code:
    Option Explicit
    
    
    Declare Function SHCreateFileDataObject Lib "shell32" Alias "#740" _
    (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pDataInner As Any, ppDataObj As Any) As Long
    
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
    
    Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    
    Const PAGE_EXECUTE_READWRITE As Long = &H40&
    
    Type UDTDataObject
            pVtable As Long
            Func(11) As Long
    End Type
    
    
    Dim tDataObject As UDTDataObject
    
    
    Sub Test()
        
        Dim DataObj As IUnknown
    
        
        Call SHCreateFileDataObject(0&, 0&, 0&, ByVal 0&, DataObj)
        
        Debug.Print DataObj Is Nothing  '<= = Returns False ( Sucess !)
    
        
        'Build the IDataObject LightWeight Interface
        With tDataObject
            .pVtable = VarPtr(.Func(0))
            .Func(0) = VBA.CLng(AddressOf QueryInterface)
            .Func(1) = VBA.CLng(AddressOf AddRef)
            .Func(2) = VBA.CLng(AddressOf Release)
            .Func(3) = VBA.CLng(AddressOf GetData)
            .Func(4) = VBA.CLng(AddressOf GetDataHere)
            .Func(5) = VBA.CLng(AddressOf QueryGetData)
            .Func(6) = VBA.CLng(AddressOf GetCanonicalFormatEtc)
            .Func(7) = VBA.CLng(AddressOf SetData)
            .Func(8) = VBA.CLng(AddressOf EnumFormatEtc)
            .Func(9) = VBA.CLng(AddressOf DAdvise)
            .Func(10) = VBA.CLng(AddressOf DUnadvise)
            .Func(11) = VBA.CLng(AddressOf EnumDAdvise)
        End With
    
    
        'Copy the DataObj to the address of the lightweight vtable.
        VirtualProtect VarPtr(tDataObject.pVtable), 4, PAGE_EXECUTE_READWRITE, 0&
        CopyMemory ByVal VarPtr(tDataObject.pVtable), DataObj, 4
        
        
        Debug.Print tDataObject.pVtable = ObjPtr(DataObj)   '<= = Returns TRUE ( Sucess !  Both point to the same object)
    
    
    End Sub
    
    
    'never gets called!"
    Private Function QueryInterface(This As UDTDataObject, ByVal riid As Long, ByRef pObj As Long) As Long
    End Function
    
    'never gets called!"
    Private Function AddRef(This As UDTDataObject) As Long
    End Function
    
    'never gets called!"
    Private Function Release(This As UDTDataObject) As Long
    End Function
    
    
    'never gets called!"
    Private Function GetData(This As UDTDataObject, ByVal pformatetcIn As Long, ByVal pmedium As Long) As Long
    End Function
    
    'never gets called!"
    Private Function GetDataHere(This As UDTDataObject, ByVal pformatetc As Long, ByVal pmedium As Long) As Long
    End Function
    
    'never gets called!"
    Private Function QueryGetData(This As UDTDataObject, ByVal pformatetc As Long) As Long
    End Function
    
    'never gets called!"
    Private Function GetCanonicalFormatEtc(This As UDTDataObject, ByVal pformatectIn As Long, ByVal pformatetcOut As Long) As Long
    End Function
    
    'never gets called!"
    Private Function SetData(This As UDTDataObject, ByVal pformatetc As Long, ByVal pmedium As Long, ByVal fRelease As Long) As Long
    End Function
    
    'never gets called!"
    Private Function EnumFormatEtc(This As UDTDataObject, ByVal dwDirection As Long, ByVal ppenumFormatEtc As Long) As Long
    End Function
    
    'never gets called!"
    Private Function DAdvise(This As UDTDataObject, ByVal pformatetc As Long, ByVal advf As Long, ByVal pAdvSink As Long, ByVal pdwConnection As Long) As Long
    End Function
    
    'never gets called!"
    Private Function DUnadvise(This As UDTDataObject, ByVal pdwConnection As Long) As Long
    End Function
    
    'never gets called!"
    Private Function EnumDAdvise(This As UDTDataObject, ByVal ppenumAdvise As LongPtr) As Long
    End Function
    Can anybody clears up the confusion I am in ?
    Last edited by JAAFAR; May 11th, 2020 at 04:44 AM.

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,102

    Re: can we create a lightweight com IDataObject ?

    Value @ ObjPtr(DataObj) is the VTable address.

    tDataObject.pVtable = ObjPtr(DataObj) is not what you need to do, that was wrong.
    If anything, you have it backwards, you need to overwrite DataObj; though not a fan of that idea. Why? Many times other data is placed in memory slots directly after the object pointer and are referenced by offsets from that address. Your tDataObject won't have those same entries, if used. And when they are referenced by the object's methods internally: crash.

    When a COM method is called, this happens (pseudo code):
    1) CopyMemory vTableAddr, ByVal ObjPtr(xxx), 4
    2) CopyMemory vFunctionPointer, ByVal vTable + [methodOrdinal*4], 4
    3) Call function @ vFunctionPointer
    In assembly, it looks a bit like this
    mov eax, [esp + 4] ' eax = ObjPtr/pThis
    mov edx, [eax] ' edx = VTable address
    push .... ' place params on stack
    push eax ' place pThis on stack
    call [edx + x] ' x = function ordinal * 4

    There are 2 typical ways we tend to 'subclass' a COM object

    1) Change the function pointer in the target's VTable, for each function wanting to subclass, to point to another function in your module. I do not prefer this option because many object instances can use the same VTable. This means every object that uses that VTable is now redirected. You will be subclassing each one of those, even though you only want to subclass just one. In Windows-subclassing terminology, this is akin to super-classing, subclassing all hWnds of the same class.

    2) Subclass the VTable by redirection. This is my preference. It only subclasses a specific instance of the object and any existing/future references to that same instance. In Windows-subclassing terminology, this is akin to subclassing a single hWnd.

    Recommendation: CopyMemory ByVal ObjPtr(DataObj), VarPtr(tDataObject.Func(0)), 4

    What that does is replace the VTable pointer with a pointer to your Func() array
    Now when DataObj methods are called, they will be rerouted to your "VTable". You should get code triggering . When you 'subclass' a COM object, you should restore the VTable pointer at some point.

    Edited: Notice there is no need to call VirtualProtect. Typically data objects including the VTable (but not the functions) are not in read-only memory. The ObjPtr, VTable address and the VTable itself are not executable. The table entries are function pointers that point to executable memory/code.

    When I redirect VTables, I will usually do it something like this (using your code as an example)
    Code:
     ' Dim DataObj As IUnknown needs to moved into the declarations section
     ' don't let it go out of scope until you are done with it
    
    With tDataObject
        CopyMemory .pVtable, ByVal ObjPtr(DataObj), 4 ' cache to be restored later
        CopyMemory .Func(0), ByVal .pVtable, 12 * 4 ' copy original 12 function pointers
        ' now for each one you want to redirect, change it. 
        ' those left unchanged call their original VTable
        .Func(3) = VBA.CLng(AddressOf GetData)
        ...
    End With ' and now begin redirection:
    CopyMemory ByVal ObjPtr(DataObj), VarPtr(tDataObject.Func(0)), 4
    And at some point, you should: CopyMemory ByVal ObjPtr(DataObj), tDataObject.pVtable, 4

    All of your functions will need to be tweaked. The 1st parameter will not be "This As UDTDataObject", instead it will be "ByVal pThis As Long". The value in pThis will be ObjPtr(DataObj).

    If you need to forward a method to the original method, do that with DispCallFunc. Do that for every method you do not specifically set the return/param values, or where you are just spying on the them and not changing anything. The original method is retrieved by the cached original VTable address:
    CopyMemory origFuncAddr, ByVal tDataObject.pVtable + [methodOrdinal*4], 4
    DispCallFunc first parameter will be zero, not ObjPtr(xxx). When building the parameter list for the call, the first in that list will be: pThis. And the number of parameters includes pThis. If you were to use ObjPtr() like in typical DispCallFunc, you'd be calling back to your VTable method, in effect, entering an infinite loop.
    Last edited by LaVolpe; May 11th, 2020 at 03:25 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Here is what I have now :

    Code:
    Option Explicit
    
    Declare Function SHCreateFileDataObject Lib "shell32" Alias "#740" _
    (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pDataInner As Any, ppDataObj As Any) As Long
    
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
    
    Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    
    Const PAGE_EXECUTE_READWRITE As Long = &H40&
    
    Type UDTDataObject
            pVtable As Long
            Func(11) As Long
    End Type
    
    
    Dim tDataObject As UDTDataObject
    Dim DataObj As IUnknown
    
    
    Sub Test()
    
            Call SHCreateFileDataObject(0&, 0&, 0&, ByVal 0&, DataObj)
    
            With tDataObject
                CopyMemory .pVtable, ByVal ObjPtr(DataObj), 4 ' cache to be restored later
                CopyMemory .Func(0), ByVal .pVtable, 12 * 4 ' copy original 12 function pointers
                .Func(3) = VBA.CLng(AddressOf GetData)
                .Func(4) = VBA.CLng(AddressOf GetDataHere)
                .Func(5) = VBA.CLng(AddressOf QueryGetData)
                .Func(6) = VBA.CLng(AddressOf GetCanonicalFormatEtc)
                .Func(7) = VBA.CLng(AddressOf SetData)
                .Func(8) = VBA.CLng(AddressOf EnumFormatEtc)
                .Func(9) = VBA.CLng(AddressOf DAdvise)
                .Func(10) = VBA.CLng(AddressOf DUnadvise)
                .Func(11) = VBA.CLng(AddressOf EnumDAdvise)
            End With
            
            ' and now begin redirection:
            CopyMemory ByVal ObjPtr(DataObj), VarPtr(tDataObject.Func(0)), 4
    
    End Sub
    running the above Test routine doesn't raise any errors but It doesnt trigger any code execution in the lightweight dataobject functions when performing copy\cut\paste operations via the user interface.


    Thanks.
    Last edited by JAAFAR; May 11th, 2020 at 04:55 PM.

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,102

    Re: can we create a lightweight com IDataObject ?

    Quote Originally Posted by JAAFAR View Post
    Here is what I have now ...

    running the above Test routine doesn't raise any errors but It doesnt trigger any code execution in the lightweight dataobject functions when performing copy\cut\paste operations via the user interface.
    We can test something. It is not a safe test...

    Try adding a bas-function for AddRef. Then include these changes to see if you are getting any events at all
    - Private Function AddRef(ByVal pThis As long) As Long
    - .Func(1) = VBA.CLng(AddressOf AddRef)
    - inside AddRef, include a statement: Debug.Print "got AddRef"
    - immediately before Test sub's End Sub statement:
    :: Dim o As IUnknown
    :: Set o = DataObj ' << this should trigger an AddRef
    :: Set o = Nothing

    Note: this test will hose up the reference count, since your AddRef function isn't actually going to increase the ref count. So backup first in case of crash, when you close the project or when the test sub exits. Either way, close the project after testing and restart VB.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,533

    Re: can we create a lightweight com IDataObject ?

    I've replaced a bunch of members of an IDataObject created with that API with VirtualProtect, and it's worked for dragdrop (and would, by extension, work for cut/paste when you set a data object directly on the clipboard with OleSetClipboard), but I couldn't tell you if it would work with the avoiding-a-tlb thing. This project may be helpful, especially when you get to needing to actually code the methods.

  6. #6

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Is this what you mean ?
    Code:
    Dim tDataObject As UDTDataObject
    Dim DataObj As IUnknown
    
    
    Sub Test()
    
            Call SHCreateFileDataObject(0&, 0&, 0&, ByVal 0&, DataObj)
    
            With tDataObject
                CopyMemory .pVtable, ByVal ObjPtr(DataObj), 4 ' cache to be restored later
                CopyMemory .Func(0), ByVal .pVtable, 12 * 4 ' copy original 12 function pointers
                .Func(3) = VBA.CLng(AddressOf GetData)
                .Func(4) = VBA.CLng(AddressOf GetDataHere)
                .Func(5) = VBA.CLng(AddressOf QueryGetData)
                .Func(6) = VBA.CLng(AddressOf GetCanonicalFormatEtc)
                .Func(7) = VBA.CLng(AddressOf SetData)
                .Func(8) = VBA.CLng(AddressOf EnumFormatEtc)
                .Func(9) = VBA.CLng(AddressOf DAdvise)
                .Func(10) = VBA.CLng(AddressOf DUnadvise)
                .Func(11) = VBA.CLng(AddressOf EnumDAdvise)
            End With
    
            ' and now begin redirection:
            CopyMemory ByVal ObjPtr(DataObj), VarPtr(tDataObject.Func(0)), 4
    
            Dim o As IUnknown
            Set o = DataObj ' << this should trigger an AddRef
            Set o = Nothing
    
    
    End Sub
    
    
    
     Private Function AddRef(ByVal pThis As Long) As Long
     
        tDataObject.Func(1) = VBA.CLng(AddressOf AddRef)
    
        MsgBox "got AddRef"
    
     End Function
    I am getting a compile error "Excpected Sub,Function or Property" highlighting the line AddressOf AddRef inside the AddRef Function.

  7. #7
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,102

    Re: can we create a lightweight com IDataObject ?

    Close, not quite:
    Code:
    Dim tDataObject As UDTDataObject
    Dim DataObj As IUnknown
    
    
    Sub Test()
    
            Call SHCreateFileDataObject(0&, 0&, 0&, ByVal 0&, DataObj)
    
            With tDataObject
                CopyMemory .pVtable, ByVal ObjPtr(DataObj), 4 ' cache to be restored later
                CopyMemory .Func(0), ByVal .pVtable, 12 * 4 ' copy original 12 function pointers
                .Func(3) = VBA.CLng(AddressOf GetData)
                .Func(4) = VBA.CLng(AddressOf GetDataHere)
                .Func(5) = VBA.CLng(AddressOf QueryGetData)
                .Func(6) = VBA.CLng(AddressOf GetCanonicalFormatEtc)
                .Func(7) = VBA.CLng(AddressOf SetData)
                .Func(8) = VBA.CLng(AddressOf EnumFormatEtc)
                .Func(9) = VBA.CLng(AddressOf DAdvise)
                .Func(10) = VBA.CLng(AddressOf DUnadvise)
                .Func(11) = VBA.CLng(AddressOf EnumDAdvise)
    
                .Func(1) = VBA.CLng(AddressOf AddRef)
    
            End With
    
            ' and now begin redirection:
            CopyMemory ByVal ObjPtr(DataObj), VarPtr(tDataObject.Func(0)), 4
    
            Dim o As IUnknown
            Set o = DataObj ' << this should trigger an AddRef
            Set o = Nothing
    
    
    End Sub
    
     Private Function AddRef(ByVal pThis As Long) As Long
     
        Debug.Print "got AddRef"  
    
     End Function
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Yes . It does raise the AddRef Method followed by a crash

  9. #9
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,102

    Re: can we create a lightweight com IDataObject ?

    Quote Originally Posted by JAAFAR View Post
    Yes . It does raise the AddRef Method followed by a crash
    That's good news, but I did say it was an unsafe test. That means you successfully hooked/subclassed the DataObj.

    If you are not giving that DataObj to any COM object or API, then it won't be accessing its events -- it is just an interface out there that is not being used.

    SHCreateFileDataObject creates an IDataObject, ok. But what you are doing with it? I think that API was designed to create an IDataObject for use with DoDragDrop API. In other words, I think SHCreateFileDataObject is designed to give you the IDataObject to be the source of a drag/drop operation.

    See fafalone's posting above also, you may have missed it.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  10. #10

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Quote Originally Posted by LaVolpe View Post
    That's good news, but I did say it was an unsafe test. That means you successfully hooked/subclassed the DataObj.

    If you are not giving that DataObj to any COM object or API, then it won't be accessing its events -- it is just an interface out there that is not being used.

    SHCreateFileDataObject creates an IDataObject, ok. But what you are doing with it? I think that API was designed to create an IDataObject for use with DoDragDrop API. In other words, I think SHCreateFileDataObject is designed to give you the IDataObject to be the source of a drag/drop operation.

    See fafalone's posting above also, you may have missed it.
    Thanks.

    fafalone's code uses a tlb which is not an option for me ... In addition, from what I undersand (I might be wrong), his code will only trigger the dataobject events when the dataobject is manipulated via code such as with the OleSetClipboard API and NOT when the user copies\pastes data in the normal way via the user interface.

  11. #11

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    I have actually prevented the crashing by handling the reference count in the AddRef function and handling the QueryIterface and Release functions...

    Now, like fafalone mentioned, using OleSetClipboard and OleGetClipboard did successflly raise the DataObject events but nothing happens at all when I copy\paste from the user interface which defeats the purpose of all we have done and brings us back to square one.

    My ultimate goal was to catch the Paste operation in excel for which excel and its child objects do not expose such event.
    Last edited by JAAFAR; May 11th, 2020 at 11:44 PM.

  12. #12
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,102

    Re: can we create a lightweight com IDataObject ?

    It shouldn't have crashed if those 3 methods were not redirected. The reason for that AddRef test was simply to see if the redirection is working -- it is.

    using OleSetClipboard and OleGetClipboard do successflly raise the DataObject events but nothing happens
    DataObject? As in VB's DataObject, not some IDataObject?

    If using VB's DataObject, why not use its OLE events instead of going through all this trouble to subclass an IDataObject interface?
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    It shouldn't have crashed if those 3 methods were not redirected. The reason for that AddRef test was simply to see if the redirection is working -- it is.
    Yes I know. Tha was just for debugging purposes.

    DataObject? As in VB's DataObject, not some IDataObject?

    If using VB's DataObject, why not use its OLE events instead of going through all this trouble to subclass an IDataObject interface?
    Not as in DataObject ... BTW, unlike VB6,excel has no DataObject .

  14. #14

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    I remember using a non-com approach in the past for working around this problem so that I could intercept the Paste event. I used API hooking(function redirection) and it did work to some extent. I hooked the legacy *GetClipboardData* function exported by the user32.dll

    The problem is that the code uses some asm-like calls (which I borrowed from the internet) addressing some specific memory locations. This no longer works in 64bit applications as the memory layout is different

    Something like this :
    Code:
    Private Sub HookFnc(ByVal module As String, ByVal fnc As String, ByVal NewAddr As Long)
        Dim hModule As Long
        Dim hFnc As Long
        
        hModule = GetModuleHandle(module)
        If hModule = 0 Then Exit Sub
        hFnc = GetProcAddress(hModule, fnc)
        If hFnc = 0 Then Exit Sub
        SetProp Application.hwnd, "GetClipDataFncAddr", hFnc
        If Not GetMem(hFnc, VarPtr(btOldAsmGetClipData(0)), UBound(btOldAsmGetClipData) + 1) Then
            Exit Sub
        End If
        Call Redirect(hFnc, NewAddr)
    End Sub
    
    Private Sub UnhookFunc(ByVal fnc As String)
       Call PutMem(GetProp(Application.hwnd, "GetClipDataFncAddr"), _
       VarPtr(btOldAsmGetClipData(0)), UBound(btOldAsmGetClipData) + 1)
    End Sub
    
    Private Function Redirect(ByVal OldAddr As Long, ByVal NewAddr As Long) As Boolean
        Dim btAsm(4)    As Byte
        Dim lngNewAddr  As Long
        
        lngNewAddr = NewAddr - OldAddr - (UBound(btAsm) + 1)
        btAsm(0) = &HE9                     ' JMP near
        CopyMemory btAsm(1), lngNewAddr, 4   ' rel. addr
        Redirect = PutMem(OldAddr, VarPtr(btAsm(0)), UBound(btAsm) + 1)
    End Function
    
    Private Function GetMem(ByVal lpAddr As Long, ByVal pData As Long, ByVal dlen As Long) As Boolean
        Dim lngOldProtect As Long
        
        If 0 = VirtualProtect(ByVal lpAddr, dlen, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
            Exit Function
        End If
        CopyMemory ByVal pData, ByVal lpAddr, dlen
        VirtualProtect ByVal lpAddr, dlen, lngOldProtect, lngOldProtect
        GetMem = True
    End Function
    
    Private Function PutMem(ByVal lpAddr As Long, ByVal pData As Long, ByVal dlen As Long) As Boolean
        Dim lngOldProtect As Long
    
        If 0 = VirtualProtect(ByVal lpAddr, dlen, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
            Exit Function
        End If
        CopyMemory ByVal lpAddr, ByVal pData, dlen
        VirtualProtect ByVal lpAddr, dlen, lngOldProtect, lngOldProtect
        PutMem = True
    End Function

  15. #15
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,589

    Re: can we create a lightweight com IDataObject ?

    You can't use simple splicing (JMP WHENEVER) in the 64-bit mode because there is no JMP [64bit] instruction. You could use MOV RAX, 64/JMP RAX or JMP QWORD [64].
    You also can check if there is a free space within 2GB within your hooked function (through VirtualQuery). So you can use JMP REL to move to this buffer so your splicing code should work (with small modifications).
    I'd also use a length-disassembly to determine the number of instruction which i can move to the buffer.

  16. #16

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Quote Originally Posted by The trick View Post
    You can't use simple splicing (JMP WHENEVER) in the 64-bit mode because there is no JMP [64bit] instruction. You could use MOV RAX, 64/JMP RAX or JMP QWORD [64].
    You also can check if there is a free space within 2GB within your hooked function (through VirtualQuery). So you can use JMP REL to move to this buffer so your splicing code should work (with small modifications).
    I'd also use a length-disassembly to determine the number of instruction which i can move to the buffer.
    Thanks The trick but I have no idea about registers or asm instructions let alone how to translate them into vb.

  17. #17

  18. #18
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,533

    Re: can we create a lightweight com IDataObject ?

    Quote Originally Posted by JAAFAR View Post
    I have actually prevented the crashing by handling the reference count in the AddRef function and handling the QueryIterface and Release functions...

    Now, like fafalone mentioned, using OleSetClipboard and OleGetClipboard did successflly raise the DataObject events but nothing happens at all when I copy\paste from the user interface which defeats the purpose of all we have done and brings us back to square one.

    My ultimate goal was to catch the Paste operation in excel for which excel and its child objects do not expose such event.
    You're talking about nothing happens like the events aren't raised somewhere else or you redirected them, and now nothing is happening?

    If you replaced the functions you'll need to write complete handling code, it won't just do the default if you do nothing. You'll need to have the replaced methods set the formats, set the data, etc. before it will be a valid drop object for another app; replacing the functions will invalidate anything you set beforehand.

    Can you describe in more detail what exactly you're doing... this it about placing something on the clipboard. Once that's done you won't get further notification about a paste in another app unless it's a specific format that needs to supply data like the demo I linked. A static format like HDROP, text, images, shellidlist, etc, once it's on the clipboard your code is done--- if this wasn't the case, you'd lose the clipboard contents once you closed the app the supplied it.

  19. #19
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,589

    Re: can we create a lightweight com IDataObject ?

    @JAAFAR,
    the simple hooker:
    Code:
    Option Explicit
    
    Public Const PAGE_EXECUTE_READWRITE As Long = &H40&
    
    Public Type tHookData
        bOriginal(0 To 13)  As Byte
        pfnOriginal         As LongPtr
        pfnHooker           As LongPtr
    End Type
    
    Public Declare PtrSafe Function LoadLibrary Lib "kernel32" _
                                    Alias "LoadLibraryW" ( _
                                    ByVal lpLibFileName As LongPtr) As LongPtr
    Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" _
                                    Alias "GetModuleHandleW" ( _
                                    ByVal lpModuleName As LongPtr) As LongPtr
    Public Declare PtrSafe Function GetProcAddress Lib "kernel32" ( _
                                    ByVal hModule As LongPtr, _
                                    ByVal lpProcName As String) As LongPtr
    Public Declare PtrSafe Function FreeLibrary Lib "kernel32" ( _
                                    ByVal hLibModule As LongPtr) As Long
    Public Declare PtrSafe Function VirtualProtect Lib "kernel32" ( _
                                    ByVal lpAddress As LongPtr, _
                                    ByVal dwSize As LongPtr, _
                                    ByVal flNewProtect As Long, _
                                    ByRef lpflOldProtect As Long) As Long
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32" _
                                    Alias "RtlMoveMemory" ( _
                                    ByRef Destination As Any, _
                                    ByRef Source As Any, _
                                    ByVal Length As LongPtr)
    Public Declare PtrSafe Function GetClipboardData Lib "user32" ( _
                                    ByVal uFormat As Long) As LongPtr
                                    
    Private m_tHook As tHookData
    
    Public Sub SetHook()
        m_tHook = Hook64(GetAPIAddress("user32", "GetClipboardData"), AddressOf GetClipboardData_hook)
    End Sub
    
    Public Sub RemoveHook()
        UnHook64 m_tHook
    End Sub
    
    Public Function GetClipboardData_hook( _
                    ByVal uFormat As Long) As LongPtr
        
        Debug.Print "GetClipboardData", uFormat
        
        UnHook64 m_tHook
        
        GetClipboardData_hook = GetClipboardData(uFormat)
        
        m_tHook = Hook64(m_tHook.pfnOriginal, m_tHook.pfnHooker)
        
    End Function
    
    Public Sub UnHook64( _
               ByRef tHook As tHookData)
        Dim lOldProtect     As Long
        
        If VirtualProtect(tHook.pfnOriginal, 14, PAGE_EXECUTE_READWRITE, lOldProtect) = 0 Then
            Err.Raise 5
        End If
        
        CopyMemory ByVal tHook.pfnOriginal, tHook.bOriginal(0), 14
        
        VirtualProtect tHook.bOriginal, 14, lOldProtect, 0
        
    End Sub
    
    Public Function Hook64( _
                    ByVal pFunction As LongPtr, _
                    ByVal pHooker As LongPtr) As tHookData
        Dim lOldProtect     As Long
        Dim bData(0 To 13)  As Byte
        
        Debug.Print Hex$(pFunction)
        
        If VirtualProtect(pFunction, 14, PAGE_EXECUTE_READWRITE, lOldProtect) = 0 Then
            Err.Raise 5
        End If
        
        bData(0) = &HFF
        bData(1) = &H25
        
        CopyMemory bData(6), pHooker, Len(pHooker)
        CopyMemory Hook64.bOriginal(0), ByVal pFunction, 14
        CopyMemory ByVal pFunction, bData(0), 14
        
        Hook64.pfnHooker = pHooker
        Hook64.pfnOriginal = pFunction
        
        VirtualProtect pFunction, 14, lOldProtect, 0
        
    End Function
    
    Public Function GetAPIAddress( _
                    ByRef sLibName As String, _
                    ByRef sFuncName As String) As LongPtr
        Dim hLib    As LongPtr
        Dim bLoaded As Boolean
        
        hLib = GetModuleHandle(StrPtr(sLibName))
        
        If hLib = 0 Then
            
            hLib = LoadLibrary(StrPtr(sLibName))
            bLoaded = True
            
        End If
        
        If hLib = 0 Then
            Err.Raise 5
        End If
        
        GetAPIAddress = GetProcAddress(hLib, sFuncName)
                               
        If GetAPIAddress = 0 Then
        
            If bLoaded Then
                FreeLibrary hLib
            End If
            
            Err.Raise 5
            
        End If
                               
    End Function

  20. #20

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Thanks fafalone.

    You're talking about nothing happens like the events aren't raised somewhere else or you redirected them, and now nothing is happening?
    I mean that once I create the lightweight object, if I put some data in the clipboard via code using OleSetClipboard, the code in the lightweight function "SetData" is raised which is good. However,if I place something in the clipboard via the user interface (for example: Ctrl+ C) the lightweight "SetData" is not triggered.

    At this stage, I am not focusing in handling formats etc ... I just need to make sure that the lightweight functions are triggered when copying\pasting manually via the user interface.

  21. #21

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2013
    Posts
    302

    Re: can we create a lightweight com IDataObject ?

    Hi The trick,

    That code is great. I will keep those generic Hook64 and UnHook64 routines for future use if I ever need to do some other API function redirection in a x64bit process.

    I will do some further testing and see what will happen.

    Thank you very much.

  22. #22
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,533

    Re: can we create a lightweight com IDataObject ?

    Quote Originally Posted by JAAFAR View Post
    Thanks fafalone.



    I mean that once I create the lightweight object, if I put some data in the clipboard via code using OleSetClipboard, the code in the lightweight function "SetData" is raised which is good. However,if I place something in the clipboard via the user interface (for example: Ctrl+ C) the lightweight "SetData" is not triggered.

    At this stage, I am not focusing in handling formats etc ... I just need to make sure that the lightweight functions are triggered when copying\pasting manually via the user interface.
    You'd have to intercept the copy/cut commands, just creating a data object doesn't hook the UI... Am I misunderstanding?

    Like intercept the keystrokes for ctl+c/x or context menu commands... If the app is using it's built in copy/cut of course it won't use your data object.

    Edit: say you have a textbox. To use your data object, you need to intercept a Ctrl+c or x press, and replace or intercept the copy/cut command, cancel it, then supply your data object instead.

    You can't just set a date object then get messages for a copy.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width