PureBasic Forums - English

Posted: **Fri Feb 21, 2014 6:56 pm**

Okay, here is the complete working version which will successfully accept and handle a Drag-and-Drop of one or more files from either the regular windows filesystem, or as attachments to email messages in Outlook (non-express). Feel free to point out any bugs and I'll update the code with a fix accordingly. Many thanks to SROD for having pre-written 90% of this already as an example of the iDropTarget interface implementation, so that I only had to fill in the handling routines for Outlook messages specifically.

Code: Select all

Structure _IDropTarget
  *vTable
  refCount.i
  blnAllowDrop.i
EndStructure

Structure FILEDESCRIPTOR
  dwFlags.l
  clsid.CLSID
  sizel.SIZE
  pointl.POINT
  dwFileAttributes.l
  ftCreationTime.FILETIME
  ftLastAccessTime.FILETIME
  ftLastWriteTime.FILETIME
  nFileSizeHigh.l
  nFileSizeLow.l
  cFileName.c[#MAX_PATH]
EndStructure

Structure FILEGROUPDESCRIPTOR
  cItems.l
  fgd.FILEDESCRIPTOR[0]
EndStructure

Structure STATSTG 
pwcsName.l
type.l
cbSize.q
mtime.FILETIME
ctime.FILETIME
atime.FILETIME
grfMode.f
grfLocksSupported.l
clsid.GUID
grfStateBits.l
reserved.l
EndStructure 

#PB_Label=1

Global cf_email = RegisterClipboardFormat_("Internet Message (rfc822/rfc1522)")
Global cf_content = RegisterClipboardFormat_(#CFSTR_FILECONTENTS)
Global cf_descrip = RegisterClipboardFormat_(#CFSTR_FILEDESCRIPTOR)

;Change this to whatever you like:
Global CopyDestination$="C:\"

OleInitialize_(0)

#Window = 0

If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
 
  *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
  *this\vTable = ?VTable_IDropTarget
  RegisterDragDrop_(WindowID(#Window), *this) ; declare our gadget as a potential drop target
  
 
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
End


;-Drop enable function.

;-Internal functions.

Procedure DropTarget_SetEffects(grfKeyState, *pdwEffect.LONG)
  If grfKeyState&#MK_CONTROL
    *pdwEffect\l = #DROPEFFECT_COPY
  ElseIf *pdwEffect\l = #DROPEFFECT_LINK|#DROPEFFECT_COPY
    *pdwEffect\l = #DROPEFFECT_COPY
  EndIf
EndProcedure




;-iDropTarget methods.

;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
  Protected result
  If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
    *ppvObject\i = *this
    *this\refCount + 1
    result = #S_OK
  Else
    *ppvObject\i=0
    result = #E_NOINTERFACE
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_AddRef(*this._IDropTarget)
  *this\refCount + 1
  ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_Release(*this._IDropTarget)
  Protected result
  *this\refCount - 1
  If *this\refCount > 0
    result = *this\refCount
  Else
    FreeMemory(*this)
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result=#S_OK, thisFormatEtc.FORMATETC
  
  *this\blnAllowDrop = #False
  
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
     With thisFormatEtc
       \cfFormat = #CF_HDROP
       \ptd =#Null
       \dwAspect = #DVASPECT_CONTENT
       \lindex = -1
       \tymed = #TYMED_HGLOBAL
     EndWith
     
     If dataObject\QueryGetData(thisFormatEtc) = #S_OK
        *this\blnAllowDrop = #True
        DropTarget_SetEffects(grfKeyState, *pdwEffect)
     EndIf
      
      With thisFormatEtc
      \cfFormat = cf_descrip
      \ptd =#Null
      \dwAspect = #DVASPECT_CONTENT
      \lindex = -1
      \tymed = #TYMED_HGLOBAL
      EndWith
   
    If dataObject\QueryGetData(thisFormatEtc) = #S_OK
      *this\blnAllowDrop = #True
      DropTarget_SetEffects(grfKeyState, *pdwEffect)
    EndIf
      
      
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
  
  Protected result = #S_OK
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    If *this\blnAllowDrop
        DropTarget_SetEffects(grfKeyState, *pdwEffect)
    Else
       *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragLeave(*this._IDropTarget)
  ProcedureReturn #S_OK
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect\l contains the original combination of effects.
Procedure.i DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK, anchWnd, tempAnchWnd, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, *ptrChar.CHARACTER
  If *pdwEffect = 0
    result = #E_INVALIDARG
  ElseIf *this\blnAllowDrop
    ;Set effects.
     DropTarget_SetEffects(grfKeyState, *pdwEffect)
    ;Do we proceed?
    If *pdwEffect\l <> #DROPEFFECT_NONE
      result=#E_FAIL  ; default result if no success below
        ;Retrieve the data. We have previously checked for valid data.
        ;Windows automatically converts between #CF_TEXT and #CF_UNICODETEXT as appropriate.
        
        ;Try regular Hglobal 
          With thisFormatEtc
            \cfFormat = #CF_HDROP
            \dwAspect = #DVASPECT_CONTENT
            \lindex = -1
            \tymed = #TYMED_HGLOBAL
          EndWith
          If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
            If thisStgMedium\hGlobal ;Only prudent to be sure here!
              buffer = AllocateMemory(1024)
              If buffer
                numFiles = DragQueryFile_(thisStgMedium\hGlobal, -1, 0, 0)
                For i = 0 To numFiles-1
                  DragQueryFile_(thisStgMedium\hGlobal, i, buffer, 1024)
                  fname$=PeekS(buffer)
                  fsname$=StringField(fname$,CountString(fname$,"\")+1,"\")
                  If CopyFile(fname$,CopyDestination$+fsname$)
                    Debug "Filesystem copy successful for: "+PeekS(buffer)
                  EndIf
                Next i
                FreeMemory(buffer)
              EndIf
            EndIf
            ReleaseStgMedium_(thisStgMedium)         
            result=0
          EndIf
          
          ;**************OUTLOOK ATTACHMENT HANDLING STARTS HERE:*******************
          
          ;Try filedescriptor/filecontents
          With thisFormatEtc
            \cfFormat = cf_descrip
            \ptd =#Null
            \dwAspect = #DVASPECT_CONTENT
            \lindex = -1
            \tymed = #TYMED_HGLOBAL
          EndWith
          If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
            
            
            ;Simple/dirty method
            *fgdbuffer.filegroupdescriptor=GlobalLock_(thisStgMedium\hGlobal)
            
; ;          Alternate method - uncomment To use
;              numbytes=GlobalSize_(thisStgMedium\hGlobal)
;              *fgdbuffer.filegroupdescriptor=AllocateMemory(numbytes)
;              *ptr=GlobalLock_(thisStgMedium\hGlobal)
;              CopyMemory(*ptr,*fgdbuffer,numbytes)
;              GlobalUnlock_(thisStgMedium\hglobal)
             
             
             numfiles=*fgdbuffer\cItems
             
             
             For x=0 To numfiles-1
            
            fname$=PeekS(@*fgdbuffer\fgd[x]\cFileName)
            
            With thisFormatEtc
            \cfFormat = cf_content
            \ptd =#Null
            \dwAspect = #DVASPECT_CONTENT
            \lindex = x
            \tymed = #TYMED_ISTREAM
            EndWith
            If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
              myStatsTG.statstg
              thisStgMedium\pstm\Stat(myStatsTG,0)
              streamsize.q=myStatsTG\cbSize
              *tempstream=AllocateMemory(streamsize)
              If thisStgMedium\pstm\Read(*tempstream,streamsize,0) = #S_OK
                OpenFile(1,CopyDestination$+fname$)
                If WriteData(1,*tempstream,streamsize)
                  Debug "Successfully saved "+CopyDestination$+fname$
                EndIf
                CloseFile(1)
              EndIf
              FreeMemory(*tempstream)
            EndIf
            
            Next x
            
            GlobalUnlock_(thisStgMedium\hGlobal)
            ReleaseStgMedium_(thisStgMedium)
        
        EndIf
     EndIf
      
    EndIf
    
  
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


DataSection
  VTable_IDropTarget:
   Data.i @DropTarget_QueryInterface()
   Data.i @DropTarget_AddRef()
   Data.i @DropTarget_Release()
   Data.i @DropTarget_DragEnter()
   Data.i @DropTarget_DragOver()
   Data.i @DropTarget_DragLeave()
   Data.i @DropTarget_Drop()

  CompilerIf Defined(IID_IUnknow, #PB_Label) = 0
    IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
      Data.l $00000000
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf

  CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
    IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
      Data.l $00000122
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf
EndDataSection

Posted: **Fri Feb 21, 2014 7:02 pm**

Glad you got it all working.

Posted: **Mon Feb 24, 2014 5:25 pm**

srod wrote:Glad you got it all working.

One other question.. is it all all possible/easy from within the IDropTarget interface to detect the calling window that has activated said interface in any given instance? Normally when sub-classing a window the standard way, the custom WindowProc will report as one of its parameters the WindowID of the window which has triggered the procedure, but I don't see any such incoming information in the default parameters of IDropTarget. If I want to implement this interface for several different windows/controls within the same application, and be able to take according action depending on which control has tripped the event, it would be useful to be able to use one master interface for all of them instead of having to create separate independent ones for each and every control I'd like to act as Drop Target.

Can this be achieved?

Posted: **Mon Feb 24, 2014 5:31 pm**

I am not sure what you mean? Are you wishing to get some information on the drag source?

Posted: **Mon Feb 24, 2014 5:46 pm**

srod wrote:I am not sure what you mean? Are you wishing to get some information on the drag source?

No, but rather the drop target itself. Suppose I create three different controls, and I register them all with the same iDropTarget interface like so:

RegisterDragDrop_(hWND1, *this)
RegisterDragDrop_(hWND2, *this)
RegisterDragDrop_(hWND3, *this)

...all three controls now use the same interface to handle incoming drops into them. Now when one of them receives something and calls the corresponding iDropTarget_Drop() method, I'd like that method/procedure to be able to tell me WHICH of the three windows using it, has called it this time. So as to avoid having to do

RegisterDragDrop_(hWND1, *this1)
RegisterDragDrop_(hWND2, *this2)
RegisterDragDrop_(hWND3, *this3)

...and replicate the droptarget interface with all its procedural code three different times for three different controls. Rather, I'd just do something like:

Code: Select all

If CallingHWND=hWND1
   Do something
ElseIf CallingHWND=hWND2
  Do something else
ElseIf CallingHWND=hWND3
  Do something different
EndIf

...within the Drop() method of one master interface, that all three controls share/use.

Posted: **Mon Feb 24, 2014 5:58 pm**

Ah simples...

The key is the '*this' structure; it is unique for each control that you register for drops with RegisterDragDrop_(WindowID(#Window), *this). This is the 'class template' for the interface and whilst the interface is unique for all iDropTarget objects, the class template need not be and can contain as many 'private' member fields as your wish.

You of course can access this structure in the drop handler.

If I can refer back to the code I posted in fangbeast's thread :

Code: Select all

Structure _IDropTarget
  *vTable
  refCount.i
  blnAllowDrop.i
EndStructure

OleInitialize_(0)

#Window = 0

If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  
  *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
  *this\vTable = ?VTable_IDropTarget
  RegisterDragDrop_(WindowID(#Window), *this) ; declare our gadget as a potential drop target
 
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
End

Add a new field to the _IDropTarget structure; e.g.

Code: Select all

Structure _IDropTarget
  *vTable
  refCount.i
  blnAllowDrop.i
  hWnd.i
EndStructure

Now alter the code :

Code: Select all

If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  
  *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
  *this\vTable = ?VTable_IDropTarget
  *this\hWnd = WindowID(#Window)
  RegisterDragDrop_(WindowID(#Window), *this) ; declare our gadget as a potential drop target
 
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

And you are done.

In your drop handler, the *this\hWnd will contain the handle of the drop window etc.

Modify as you need.

Posted: **Mon Feb 24, 2014 6:25 pm**

srod wrote:The key is the '*this' structure; it is unique for each control that you register for drops with RegisterDragDrop_(WindowID(#Window), *this). This is the 'class template' for the interface and whilst the interface is unique for all iDropTarget objects, the class template need not be and can contain as many 'private' member fields as your wish.

D'oh.... of course! The *this is a newly instantiated object of the iDropTarget class and a new one is created with unique variables for every control, even though they all have references to the same defined procedural methods of the class. Makes perfect sense and I feel silly for not twigging to that earlier.

So I'd just create *that.idroptarget for the second control, and *theother.idroptatget for the third, etc.... and set the hWND field each time accordingly. Sounds about right, and just worked as expected in a test I ran, so thanks yet again!

Posted: **Fri Jan 30, 2015 3:23 pm**

sorry to bump this thread.

I can't get the code to run as it complains that the #PB_Label constant is already declared.

I can comment it out and the code runs, but doesn't do what it's supposed to, so i debuged the value of #PB_label and it returns 56 so is this affecting the code ??

I don't understand the compiler directives so any help appreciated.

cheers

Code: Select all

    Structure _IDropTarget
      *vTable
      refCount.i
      blnAllowDrop.i
    EndStructure

    Structure FILEDESCRIPTOR
      dwFlags.l
      clsid.CLSID
      sizel.SIZE
      pointl.POINT
      dwFileAttributes.l
      ftCreationTime.FILETIME
      ftLastAccessTime.FILETIME
      ftLastWriteTime.FILETIME
      nFileSizeHigh.l
      nFileSizeLow.l
      cFileName.c[#MAX_PATH]
    EndStructure

    Structure FILEGROUPDESCRIPTOR
      cItems.l
      fgd.FILEDESCRIPTOR[0]
    EndStructure

    Structure STATSTG
    pwcsName.l
    type.l
    cbSize.q
    mtime.FILETIME
    ctime.FILETIME
    atime.FILETIME
    grfMode.f
    grfLocksSupported.l
    clsid.GUID
    grfStateBits.l
    reserved.l
    EndStructure

    #PB_Label=1

    Global cf_email = RegisterClipboardFormat_("Internet Message (rfc822/rfc1522)")
    Global cf_content = RegisterClipboardFormat_(#CFSTR_FILECONTENTS)
    Global cf_descrip = RegisterClipboardFormat_(#CFSTR_FILEDESCRIPTOR)

    ;Change this to whatever you like:
    Global CopyDestination$="C:\"

    OleInitialize_(0)

    #Window = 0

    If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
     
      *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
      *this\vTable = ?VTable_IDropTarget
      RegisterDragDrop_(WindowID(#Window), *this) ; declare our gadget as a potential drop target
     
     
      Repeat
        Event = WaitWindowEvent()
      Until Event = #PB_Event_CloseWindow
    EndIf
    End


    ;-Drop enable function.

    ;-Internal functions.

    Procedure DropTarget_SetEffects(grfKeyState, *pdwEffect.LONG)
      If grfKeyState&#MK_CONTROL
        *pdwEffect\l = #DROPEFFECT_COPY
      ElseIf *pdwEffect\l = #DROPEFFECT_LINK|#DROPEFFECT_COPY
        *pdwEffect\l = #DROPEFFECT_COPY
      EndIf
    EndProcedure




    ;-iDropTarget methods.

    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
      Protected result
      If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
        *ppvObject\i = *this
        *this\refCount + 1
        result = #S_OK
      Else
        *ppvObject\i=0
        result = #E_NOINTERFACE
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_AddRef(*this._IDropTarget)
      *this\refCount + 1
      ProcedureReturn 0
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_Release(*this._IDropTarget)
      Protected result
      *this\refCount - 1
      If *this\refCount > 0
        result = *this\refCount
      Else
        FreeMemory(*this)
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
      Protected result=#S_OK, thisFormatEtc.FORMATETC
     
      *this\blnAllowDrop = #False
     
      If *pdwEffect = 0
        result = #E_INVALIDARG
      Else
         With thisFormatEtc
           \cfFormat = #CF_HDROP
           \ptd =#Null
           \dwAspect = #DVASPECT_CONTENT
           \lindex = -1
           \tymed = #TYMED_HGLOBAL
         EndWith
         
         If dataObject\QueryGetData(thisFormatEtc) = #S_OK
            *this\blnAllowDrop = #True
            DropTarget_SetEffects(grfKeyState, *pdwEffect)
         EndIf
         
          With thisFormatEtc
          \cfFormat = cf_descrip
          \ptd =#Null
          \dwAspect = #DVASPECT_CONTENT
          \lindex = -1
          \tymed = #TYMED_HGLOBAL
          EndWith
       
        If dataObject\QueryGetData(thisFormatEtc) = #S_OK
          *this\blnAllowDrop = #True
          DropTarget_SetEffects(grfKeyState, *pdwEffect)
        EndIf
         
         
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
     
      Protected result = #S_OK
      If *pdwEffect = 0
        result = #E_INVALIDARG
      Else
        If *this\blnAllowDrop
            DropTarget_SetEffects(grfKeyState, *pdwEffect)
        Else
           *pdwEffect\l = #DROPEFFECT_NONE
        EndIf
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_DragLeave(*this._IDropTarget)
      ProcedureReturn #S_OK
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    ;*pdwEffect\l contains the original combination of effects.
    Procedure.i DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
      Protected result = #S_OK, anchWnd, tempAnchWnd, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, *ptrChar.CHARACTER
      If *pdwEffect = 0
        result = #E_INVALIDARG
      ElseIf *this\blnAllowDrop
        ;Set effects.
         DropTarget_SetEffects(grfKeyState, *pdwEffect)
        ;Do we proceed?
        If *pdwEffect\l <> #DROPEFFECT_NONE
          result=#E_FAIL  ; default result if no success below
            ;Retrieve the data. We have previously checked for valid data.
            ;Windows automatically converts between #CF_TEXT and #CF_UNICODETEXT as appropriate.
           
            ;Try regular Hglobal
              With thisFormatEtc
                \cfFormat = #CF_HDROP
                \dwAspect = #DVASPECT_CONTENT
                \lindex = -1
                \tymed = #TYMED_HGLOBAL
              EndWith
              If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
                If thisStgMedium\hGlobal ;Only prudent to be sure here!
                  buffer = AllocateMemory(1024)
                  If buffer
                    numFiles = DragQueryFile_(thisStgMedium\hGlobal, -1, 0, 0)
                    For i = 0 To numFiles-1
                      DragQueryFile_(thisStgMedium\hGlobal, i, buffer, 1024)
                      fname$=PeekS(buffer)
                      fsname$=StringField(fname$,CountString(fname$,"\")+1,"\")
                      If CopyFile(fname$,CopyDestination$+fsname$)
                        Debug "Filesystem copy successful for: "+PeekS(buffer)
                      EndIf
                    Next i
                    FreeMemory(buffer)
                  EndIf
                EndIf
                ReleaseStgMedium_(thisStgMedium)         
                result=0
              EndIf
             
              ;**************OUTLOOK ATTACHMENT HANDLING STARTS HERE:*******************
             
              ;Try filedescriptor/filecontents
              With thisFormatEtc
                \cfFormat = cf_descrip
                \ptd =#Null
                \dwAspect = #DVASPECT_CONTENT
                \lindex = -1
                \tymed = #TYMED_HGLOBAL
              EndWith
              If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
               
               
                ;Simple/dirty method
                *fgdbuffer.filegroupdescriptor=GlobalLock_(thisStgMedium\hGlobal)
               
    ; ;          Alternate method - uncomment To use
    ;              numbytes=GlobalSize_(thisStgMedium\hGlobal)
    ;              *fgdbuffer.filegroupdescriptor=AllocateMemory(numbytes)
    ;              *ptr=GlobalLock_(thisStgMedium\hGlobal)
    ;              CopyMemory(*ptr,*fgdbuffer,numbytes)
    ;              GlobalUnlock_(thisStgMedium\hglobal)
                 
                 
                 numfiles=*fgdbuffer\cItems
                 
                 
                 For x=0 To numfiles-1
               
                fname$=PeekS(@*fgdbuffer\fgd[x]\cFileName)
               
                With thisFormatEtc
                \cfFormat = cf_content
                \ptd =#Null
                \dwAspect = #DVASPECT_CONTENT
                \lindex = x
                \tymed = #TYMED_ISTREAM
                EndWith
                If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
                  myStatsTG.statstg
                  thisStgMedium\pstm\Stat(myStatsTG,0)
                  streamsize.q=myStatsTG\cbSize
                  *tempstream=AllocateMemory(streamsize)
                  If thisStgMedium\pstm\Read(*tempstream,streamsize,0) = #S_OK
                    OpenFile(1,CopyDestination$+fname$)
                    If WriteData(1,*tempstream,streamsize)
                      Debug "Successfully saved "+CopyDestination$+fname$
                    EndIf
                    CloseFile(1)
                  EndIf
                  FreeMemory(*tempstream)
                EndIf
               
                Next x
               
                GlobalUnlock_(thisStgMedium\hGlobal)
                ReleaseStgMedium_(thisStgMedium)
           
            EndIf
         EndIf
         
        EndIf
       
     
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    DataSection
      VTable_IDropTarget:
       Data.i @DropTarget_QueryInterface()
       Data.i @DropTarget_AddRef()
       Data.i @DropTarget_Release()
       Data.i @DropTarget_DragEnter()
       Data.i @DropTarget_DragOver()
       Data.i @DropTarget_DragLeave()
       Data.i @DropTarget_Drop()

      CompilerIf Defined(IID_IUnknow, #PB_Label) = 0
        IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
          Data.l $00000000
          Data.w $0000,$0000
          Data.b $C0,$00,$00,$00,$00,$00,$00,$46
      CompilerEndIf

      CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
        IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
          Data.l $00000122
          Data.w $0000,$0000
          Data.b $C0,$00,$00,$00,$00,$00,$00,$46
      CompilerEndIf
    EndDataSection

Posted: **Fri Jan 30, 2015 4:13 pm**

captain_skank wrote:sorry to bump this thread.

I can't get the code to run as it complains that the #PB_Label constant is already declared.

I can comment it out and the code runs, but doesn't do what it's supposed to, so i debuged the value of #PB_label and it returns 56 so is this affecting the code ??

I don't understand the compiler directives so any help appreciated.

cheers

At the time I was working on this, I was using PB version 4.60, and so I had to manually define that #PB_Label constant in order to leave srod's code mostly intact. I just tested it a moment ago under version 5.31, and commenting out the constant definition allowed the code to run as expected for me here.

All the test program attempts to do is accept a drag-and-drop file from Outlook (or any other source) and save a new copy of the detected file in the root of "C:\" or wherever you change the global CopyDestination$ variable on line 47 to point to. If the debugger is enabled it should pop up a message indicating that the file was successfully saved to that location.

What results are you getting when you run it on your system?

Posted: **Fri Jan 30, 2015 4:27 pm**

hi mesozorn, thanks for the reply.

First off i was unsure what problem not being able to set the constant would cause.

Once commented out the code works as advertised - allowing me to drag and drop an attachment from an outlook (2010) message.

I'd misread part of the thread and was exepcting it to drop the message

Is there any way to drag and drop the just the meassage? maybe as .msg

Posted: **Fri Jan 30, 2015 11:24 pm**

captain_skank wrote:Is there any way to drag and drop the just the meassage? maybe as .msg

Well, this took me all mother-flipping day to get right, and I haven't exactly tested it extensively, but it seems to work correctly for dropping any number of emails from Outlook, with or without attachments, and saving those emails as .msg files in the destination directory. They can then be double-clicked to open via Outlook thereafter:

Code: Select all

Structure _IDropTarget
      *vTable
      refCount.i
      blnAllowDrop.i
    EndStructure

    Structure FILEDESCRIPTOR
      dwFlags.l
      clsid.CLSID
      sizel.SIZE
      pointl.POINT
      dwFileAttributes.l
      ftCreationTime.FILETIME
      ftLastAccessTime.FILETIME
      ftLastWriteTime.FILETIME
      nFileSizeHigh.l
      nFileSizeLow.l
      cFileName.c[#MAX_PATH]
    EndStructure

    Structure FILEGROUPDESCRIPTOR
      cItems.l
      fgd.FILEDESCRIPTOR[0]
    EndStructure

    Structure STATSTG
    pwcsName.l
    type.l
    cbSize.q
    mtime.FILETIME
    ctime.FILETIME
    atime.FILETIME
    grfMode.f
    grfLocksSupported.l
    clsid.GUID
    grfStateBits.l
    reserved.l
    EndStructure

    ;#PB_Label=1

    Global cf_email = RegisterClipboardFormat_("Internet Message (rfc822/rfc1522)")
    Global cf_content = RegisterClipboardFormat_(#CFSTR_FILECONTENTS)
    Global cf_descrip = RegisterClipboardFormat_(#CFSTR_FILEDESCRIPTOR)

    ;Change this to whatever you like:
    Global CopyDestination$="C:\"

    OleInitialize_(0)

    #Window = 0

    If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
     
      *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
      *this\vTable = ?VTable_IDropTarget
      RegisterDragDrop_(WindowID(#Window), *this) ; declare our gadget as a potential drop target
     
     
      Repeat
        Event = WaitWindowEvent()
      Until Event = #PB_Event_CloseWindow
    EndIf
    End


    ;-Drop enable function.

    ;-Internal functions.

    Procedure DropTarget_SetEffects(grfKeyState, *pdwEffect.LONG)
      If grfKeyState&#MK_CONTROL
        *pdwEffect\l = #DROPEFFECT_COPY
      ElseIf *pdwEffect\l = #DROPEFFECT_LINK|#DROPEFFECT_COPY
        *pdwEffect\l = #DROPEFFECT_COPY
      EndIf
    EndProcedure




    ;-iDropTarget methods.

    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
      Protected result
      If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
        *ppvObject\i = *this
        *this\refCount + 1
        result = #S_OK
      Else
        *ppvObject\i=0
        result = #E_NOINTERFACE
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_AddRef(*this._IDropTarget)
      *this\refCount + 1
      ProcedureReturn 0
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_Release(*this._IDropTarget)
      Protected result
      *this\refCount - 1
      If *this\refCount > 0
        result = *this\refCount
      Else
        FreeMemory(*this)
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
      Protected result=#S_OK, thisFormatEtc.FORMATETC
     
      *this\blnAllowDrop = #False
     
      If *pdwEffect = 0
        result = #E_INVALIDARG
      Else
         With thisFormatEtc
           \cfFormat = #CF_HDROP
           \ptd =#Null
           \dwAspect = #DVASPECT_CONTENT
           \lindex = -1
           \tymed = #TYMED_HGLOBAL
         EndWith
         
         If dataObject\QueryGetData(thisFormatEtc) = #S_OK
            *this\blnAllowDrop = #True
            DropTarget_SetEffects(grfKeyState, *pdwEffect)
         EndIf
         
          With thisFormatEtc
          \cfFormat = cf_descrip
          \ptd =#Null
          \dwAspect = #DVASPECT_CONTENT
          \lindex = -1
          \tymed = #TYMED_HGLOBAL
          EndWith
       
        If dataObject\QueryGetData(thisFormatEtc) = #S_OK
          *this\blnAllowDrop = #True
          DropTarget_SetEffects(grfKeyState, *pdwEffect)
        EndIf
         
         
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
     
      Protected result = #S_OK
      If *pdwEffect = 0
        result = #E_INVALIDARG
      Else
        If *this\blnAllowDrop
            DropTarget_SetEffects(grfKeyState, *pdwEffect)
        Else
           *pdwEffect\l = #DROPEFFECT_NONE
        EndIf
      EndIf
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    Procedure.i DropTarget_DragLeave(*this._IDropTarget)
      ProcedureReturn #S_OK
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    ;/////////////////////////////////////////////////////////////////////////////////
    ;*pdwEffect\l contains the original combination of effects.
    Procedure.i DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
      Protected result = #S_OK, anchWnd, tempAnchWnd, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, *ptrChar.CHARACTER
      If *pdwEffect = 0
        result = #E_INVALIDARG
      ElseIf *this\blnAllowDrop
        ;Set effects.
         DropTarget_SetEffects(grfKeyState, *pdwEffect)
        ;Do we proceed?
        If *pdwEffect\l <> #DROPEFFECT_NONE
          result=#E_FAIL  ; default result if no success below
            ;Retrieve the data. We have previously checked for valid data.
            ;Windows automatically converts between #CF_TEXT and #CF_UNICODETEXT as appropriate.
           
            ;Try regular Hglobal
              With thisFormatEtc
                \cfFormat = #CF_HDROP
                \dwAspect = #DVASPECT_CONTENT
                \lindex = -1
                \tymed = #TYMED_HGLOBAL
              EndWith
              If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
                If thisStgMedium\hGlobal ;Only prudent to be sure here!
                  buffer = AllocateMemory(1024)
                  If buffer
                    numFiles = DragQueryFile_(thisStgMedium\hGlobal, -1, 0, 0)
                    For i = 0 To numFiles-1
                      DragQueryFile_(thisStgMedium\hGlobal, i, buffer, 1024)
                      fname$=PeekS(buffer)
                      fsname$=StringField(fname$,CountString(fname$,"\")+1,"\")
                      If CopyFile(fname$,CopyDestination$+fsname$)
                        Debug "Filesystem copy successful for: "+PeekS(buffer)
                      EndIf
                    Next i
                    FreeMemory(buffer)
                  EndIf
                EndIf
                ReleaseStgMedium_(thisStgMedium)         
                result=0
              EndIf
             
              ;**************OUTLOOK ATTACHMENT HANDLING STARTS HERE:*******************
             
        
              
              
              ;Try filedescriptor/filecontents
              With thisFormatEtc
                \cfFormat = cf_descrip
                \ptd =#Null
                \dwAspect = #DVASPECT_CONTENT
                \lindex = -1
                \tymed = #TYMED_HGLOBAL
              EndWith
              If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
               
               
                ;Simple/dirty method
                *fgdbuffer.filegroupdescriptor=GlobalLock_(thisStgMedium\hGlobal)
               
    ; ;          Alternate method - uncomment To use
    ;              numbytes=GlobalSize_(thisStgMedium\hGlobal)
    ;              *fgdbuffer.filegroupdescriptor=AllocateMemory(numbytes)
    ;              *ptr=GlobalLock_(thisStgMedium\hGlobal)
    ;              CopyMemory(*ptr,*fgdbuffer,numbytes)
    ;              GlobalUnlock_(thisStgMedium\hglobal)
                 
                 
                numfiles=*fgdbuffer\cItems
                                 
                 
                 For x=0 To numfiles-1
               
                   fname$=PeekS(@*fgdbuffer\fgd[x]\cFileName)
                   
               
                With thisFormatEtc
                \cfFormat = cf_content
                \ptd =#Null
                \dwAspect = #DVASPECT_CONTENT
                \lindex = x
                \tymed = #TYMED_ISTREAM
                EndWith
                If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
                  myStatsTG.statstg
                  thisStgMedium\pstm\Stat(myStatsTG,0)
                  streamsize.q=myStatsTG\cbSize
                  *tempstream=AllocateMemory(streamsize)
                  If thisStgMedium\pstm\Read(*tempstream,streamsize,0) = #S_OK
                    OpenFile(1,CopyDestination$+fname$)
                    If WriteData(1,*tempstream,streamsize)
                      Debug "Successfully saved "+CopyDestination$+fname$
                    EndIf
                    CloseFile(1)
                  EndIf
                  FreeMemory(*tempstream)
                  
                Else
                      
                  With thisFormatEtc
                    \cfFormat = cf_content
                    \ptd =#Null
                    \dwAspect = #DVASPECT_CONTENT
                    \lindex = x
                    \tymed = #TYMED_ISTORAGE
                  EndWith
                  If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
                    *lock.ilockbytes
                    *mystream.istream
                    *storageCopy.istorage
                    hglob.l
                    
                    CreateILockBytesOnHGlobal_(0, #False, @*lock)
                    StgCreateDocfileOnILockBytes_(*lock, 16 | 4096 | 2,0, @*storageCopy)
                    thisstgmedium\pstg\CopyTo(0,#Null,#Null,*storageCopy)
                    *storageCopy\Commit(#STGC_DEFAULT)
                    GetHGlobalFromILockBytes_(*lock, @hglob)
                    CreateStreamOnHGlobal_(hglob,0,@*mystream)
                    
                    *mystream\stat(ostats.statstg,0)
                    streamsize.q=ostats\cbSize
                    *tempstream=AllocateMemory(streamsize)
                    *mystream\read(*tempstream,streamsize,0)
                    OpenFile(1,CopyDestination$+fname$)
                    If WriteData(1,*tempstream,streamsize)
                      Debug "Successfully saved "+CopyDestination$+fname$
                    EndIf
                    CloseFile(1)
                    FreeMemory(*tempstream)
                    *mystream\Release()
                    *storageCopy\Release()
                    
                    
                  EndIf
                  
                  
                  
                  
                  
                  
                  
                  
                EndIf
               
                Next x
               
                GlobalUnlock_(thisStgMedium\hGlobal)
                ReleaseStgMedium_(thisStgMedium)
           
            EndIf
         EndIf
         
        EndIf
       
     
      ProcedureReturn result
    EndProcedure
    ;/////////////////////////////////////////////////////////////////////////////////


    DataSection
      VTable_IDropTarget:
       Data.i @DropTarget_QueryInterface()
       Data.i @DropTarget_AddRef()
       Data.i @DropTarget_Release()
       Data.i @DropTarget_DragEnter()
       Data.i @DropTarget_DragOver()
       Data.i @DropTarget_DragLeave()
       Data.i @DropTarget_Drop()

      CompilerIf Defined(IID_IUnknow, #PB_Label) = 0
        IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
          Data.l $00000000
          Data.w $0000,$0000
          Data.b $C0,$00,$00,$00,$00,$00,$00,$46
      CompilerEndIf

      CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
        IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
          Data.l $00000122
          Data.w $0000,$0000
          Data.b $C0,$00,$00,$00,$00,$00,$00,$46
      CompilerEndIf
    EndDataSection

Posted: **Mon Feb 02, 2015 11:23 am**

Once again mesozorn, thanks.

This is a big help for my current project and means my users can stop faffing around cut and pasting text into a word document.

All i've got to do now is understand how you did it

Posted: **Mon Feb 02, 2015 4:33 pm**

captain_skank wrote:Once again mesozorn, thanks.

This is a big help for my current project and means my users can stop faffing around cut and pasting text into a word document.

All i've got to do now is understand how you did it

No trouble and glad to help. Outlook messages are served by the windows drag-drop system using the "IStorage" interface, so just look at the section that begins with handling that media type in the code above. The lines that follow use some elaborate-looking API's to convert the istorage into an istream, so that from there it can be written to a file just as with dropped attachments handled in the section directly above.

It is also possible to read the message text itself directly from the istorage interface if desired, without too much extra difficulty. It just involves calling the EnumElements method of the IStorage to return an array of STATSTG structures, one of which will contain the message text, another the subject heading, etc. So if you just want the text itself it might be the easier way to go.

Posted: **Wed Feb 04, 2015 2:45 pm**

This is exactly what I need, thanks a lot mesozorn!

I already had a long unsuccessful fight with Drag&Drop and Outlook.

I just made your code a little more userfriendly if you don't mind.

Maybe you should post it to Tipps & Tricks, otherwise it could get lost.

Code: Select all

;/------------------------
;|
;| Outlook_DragAndDrop.pbi V1.01
;|
;| original code from mesozorn:
;| http://www.purebasic.fr/english/viewtopic.php?p=460210#p460210
;|
;| implemented ideas from srod:
;| http://www.purebasic.fr/english/viewtopic.php?p=438986#p438986
;|
;| just made it a little more "user friendly"
;| Code home: https://www.purebasic.fr/english/viewtopic.php?p=460437#p460437
;|
;| 24.03.2025 Bugfixes DropTarget_Drop() - FilesSize = 2 byte
;| from maddinvonfritz => https://www.purebasic.fr/german/viewtopic.php?p=367463#p367463 (just removed German variable names)
;|
;/------------------------


DeclareModule ODD  ;Outlook Drag&Drop
	Declare SetGadgetOutlookDrop(Gadget, StorageFolder.s, MessageWindow, MessageWindowEvent)
	
	OleInitialize_(0)
EndDeclareModule

Module ODD
	EnableExplicit
	
	Structure _IDropTarget
		*vTable
		refCount.i
		blnAllowDrop.i
		hWnd.i
	EndStructure
	
	Structure FILEDESCRIPTOR
		dwFlags.l
		clsid.CLSID
		sizel.SIZE
		pointl.POINT
		dwFileAttributes.l
		ftCreationTime.FILETIME
		ftLastAccessTime.FILETIME
		ftLastWriteTime.FILETIME
		nFileSizeHigh.l
		nFileSizeLow.l
		cFileName.c[#MAX_PATH]
	EndStructure
	
	Structure FILEGROUPDESCRIPTOR
		cItems.l
		fgd.FILEDESCRIPTOR[0]
	EndStructure
	
	Structure STATSTG
		pwcsName.l
		type.l
		cbSize.q
		mtime.FILETIME
		ctime.FILETIME
		atime.FILETIME
		grfMode.f
		grfLocksSupported.l
		clsid.GUID
		grfStateBits.l
		reserved.l
	EndStructure
	
	Structure ODD_MAP
		Gadget.i
		MessageWindow.i
		MessageWindowEvent.i
		Folder.s
	EndStructure
	
	
	Global cf_email   = RegisterClipboardFormat_("Internet Message (rfc822/rfc1522)")
	Global cf_content = RegisterClipboardFormat_(#CFSTR_FILECONTENTS)
	Global cf_descrip = RegisterClipboardFormat_(#CFSTR_FILEDESCRIPTOR)
	
	Global NewMap ODD.ODD_MAP()
	
	Macro M_SEND_DROP_FILES
		If DroppedFiles
			DroppedFiles = Left(DroppedFiles, Len(DroppedFiles) - 1)
			If ODD()\MessageWindowEvent And IsWindow(ODD()\MessageWindow)
				buffer = AllocateMemory(StringByteLength(DroppedFiles) + 2)
				If buffer
					PokeS(buffer, DroppedFiles)
					PostEvent(ODD()\MessageWindowEvent, ODD()\MessageWindow, ODD()\Gadget, #False, buffer)
					;Debug "Filesystem copy successful for: "+PeekS(buffer)
				EndIf
			EndIf
			DroppedFiles = ""
		EndIf
	EndMacro
	
	;-Drop enable function.
	
	;-Internal functions.
	
	Procedure DropTarget_SetEffects(grfKeyState, *pdwEffect.LONG)
		
		If grfKeyState & #MK_CONTROL
			*pdwEffect\l = #DROPEFFECT_COPY
		ElseIf *pdwEffect\l = #DROPEFFECT_LINK | #DROPEFFECT_COPY
			*pdwEffect\l = #DROPEFFECT_COPY
		EndIf
		
	EndProcedure
	
	;-iDropTarget methods.
	
	;/////////////////////////////////////////////////////////////////////////////////
	Procedure DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
		Protected Result
		
		If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
			*ppvObject\i = *this
			*this\refCount + 1
			Result = #S_OK
		Else
			*ppvObject\i = 0
			Result       = #E_NOINTERFACE
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	
	;/////////////////////////////////////////////////////////////////////////////////
	Procedure DropTarget_AddRef(*this._IDropTarget)
		
		*this\refCount + 1
		
		ProcedureReturn 0
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	
	;/////////////////////////////////////////////////////////////////////////////////
	Procedure DropTarget_Release(*this._IDropTarget)
		Protected Result
		
		*this\refCount - 1
		If *this\refCount > 0
			Result = *this\refCount
		Else
			FreeMemory(*this)
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	
	;/////////////////////////////////////////////////////////////////////////////////
	Procedure DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
		Protected Result = #S_OK, thisFormatEtc.FORMATETC
		
		*this\blnAllowDrop = #False
		
		If *pdwEffect = 0
			Result = #E_INVALIDARG
		Else
			With thisFormatEtc
				\cfFormat = #CF_HDROP
				\ptd      = #Null
				\dwAspect = #DVASPECT_CONTENT
				\lindex   = -1
				\tymed    = #TYMED_HGLOBAL
			EndWith
			
			If dataObject\QueryGetData(thisFormatEtc) = #S_OK
				*this\blnAllowDrop = #True
				DropTarget_SetEffects(grfKeyState, *pdwEffect)
			EndIf
			
			With thisFormatEtc
				\cfFormat = cf_descrip
				\ptd      = #Null
				\dwAspect = #DVASPECT_CONTENT
				\lindex   = -1
				\tymed    = #TYMED_HGLOBAL
			EndWith
			
			If dataObject\QueryGetData(thisFormatEtc) = #S_OK
				*this\blnAllowDrop = #True
				DropTarget_SetEffects(grfKeyState, *pdwEffect)
			EndIf
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	
	;/////////////////////////////////////////////////////////////////////////////////
	Procedure DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
		Protected Result = #S_OK
		
		If *pdwEffect = 0
			Result = #E_INVALIDARG
		Else
			If *this\blnAllowDrop
				DropTarget_SetEffects(grfKeyState, *pdwEffect)
			Else
				*pdwEffect\l = #DROPEFFECT_NONE
			EndIf
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	
	;/////////////////////////////////////////////////////////////////////////////////
	Procedure DropTarget_DragLeave(*this._IDropTarget)
		
		ProcedureReturn #S_OK
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	
	;/////////////////////////////////////////////////////////////////////////////////
	;*pdwEffect\l contains the original combination of effects.
	Procedure DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
		Protected Result, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM
		Protected FID, streamsize.q, *tempstream, buffer
		Protected *lock.ilockbytes, *mystream.istream, *storageCopy.istorage, hglob.i, bytes.q
		Protected numFiles, i, fname$, fsname$, *fgdbuffer.filegroupdescriptor, DroppedFiles.s, *DroppedFilesBuffer
		
		If *pdwEffect = 0
			Result = #E_INVALIDARG
		ElseIf FindMapElement(ODD(), Str(*this\hWnd)) = 0
			;
		ElseIf *this\blnAllowDrop
			;Set effects.
			DropTarget_SetEffects(grfKeyState, *pdwEffect)
			;Do we proceed?
			If *pdwEffect\l <> #DROPEFFECT_NONE
				Result = #E_FAIL  ;default result if no success below
				;Retrieve the data. We have previously checked for valid data.
				;Windows automatically converts between #CF_TEXT and #CF_UNICODETEXT as appropriate.
				
				;Try regular Hglobal
				With thisFormatEtc
					\cfFormat = #CF_HDROP
					\dwAspect = #DVASPECT_CONTENT
					\lindex   = -1
					\tymed    = #TYMED_HGLOBAL
				EndWith
				
				DroppedFiles = ""
				If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
					If thisStgMedium\hGlobal ;Only prudent to be sure here!
						buffer = AllocateMemory(1024)
						If buffer
							numFiles = DragQueryFile_(thisStgMedium\hGlobal, - 1, 0, 0)
							
							For i = 0 To numFiles - 1
								DragQueryFile_(thisStgMedium\hGlobal, i, buffer, 1024)
								fname$  = PeekS(buffer)
								fsname$ = StringField(fname$, CountString(fname$, "\") + 1, "\")
								
								If CopyFile(fname$, ODD()\Folder + fsname$)
									DroppedFiles + ODD()\Folder + fsname$ + #LF$
								EndIf
							Next i
							FreeMemory(buffer)
						EndIf
						M_SEND_DROP_FILES
					EndIf
					ReleaseStgMedium_(thisStgMedium)
					Result = 0
				EndIf
				
				;**************OUTLOOK ATTACHMENT HANDLING STARTS HERE:*******************
				
				
				;Try filedescriptor/filecontents
				With thisFormatEtc
					\cfFormat = cf_descrip
					\ptd      = #Null
					\dwAspect = #DVASPECT_CONTENT
					\lindex   = -1
					\tymed    = #TYMED_HGLOBAL
				EndWith
				If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
					;Simple/dirty method
					*fgdbuffer = GlobalLock_(thisStgMedium\hGlobal)
					
					;         Alternate method - uncomment To use
					;           numbytes   = GlobalSize_(thisStgMedium\hGlobal)
					;           *fgdbuffer = AllocateMemory(numbytes)
					;           *ptr       = GlobalLock_(thisStgMedium\hGlobal)
					;           CopyMemory(*ptr, *fgdbuffer, numbytes)
					;           GlobalUnlock_(thisStgMedium\hglobal)
					
					
					numfiles = *fgdbuffer\cItems
					
					For i = 0 To numfiles - 1
						
						fname$ = PeekS(@*fgdbuffer\fgd[i]\cFileName)
						
						With thisFormatEtc
							\cfFormat = cf_content
							\ptd      = #Null
							\dwAspect = #DVASPECT_CONTENT
							\lindex   = i
							\tymed    = #TYMED_ISTREAM
						EndWith
						
						If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
							thisStgMedium\pstm\Seek(0, #STREAM_SEEK_END, @streamsize)
							thisStgMedium\pstm\Seek(0, #STREAM_SEEK_SET, 0)
							*tempstream = AllocateMemory(streamsize)
							If thisStgMedium\pstm\Read(*tempstream, streamsize, @bytes) = #S_OK
								If FindMapElement(ODD(), Str(*this\hWnd)) And bytes > 0
									FID = CreateFile(#PB_Any, ODD()\Folder + fname$)
									If FID
										WriteData(FID, *tempstream, bytes)
										CloseFile(FID)
										DroppedFiles + ODD()\Folder + fname$ + " - " + FileSize(ODD()\Folder + fname$) + "bytes" + #LF$
									EndIf
								EndIf
							EndIf
							
							FreeMemory(*tempstream)
							
						Else
							
							With thisFormatEtc
								\cfFormat = cf_content
								\ptd      = #Null
								\dwAspect = #DVASPECT_CONTENT
								\lindex   = 0
								\tymed    = #TYMED_ISTORAGE
							EndWith
							
							If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
								CreateILockBytesOnHGlobal_(0, #False, @*lock)
								StgCreateDocfileOnILockBytes_(*lock, 16 | 4096 | 2, 0, @*storageCopy)
								thisstgmedium\pstg\CopyTo(0, #Null, #Null, *storageCopy)
								*storageCopy\Commit(#STGC_DEFAULT)
								GetHGlobalFromILockBytes_(*lock, @hglob)
								CreateStreamOnHGlobal_(hglob, 0, @*mystream)
								
								*mystream\Seek(0, #STREAM_SEEK_END, @streamsize)
								*mystream\Seek(0, #STREAM_SEEK_SET, 0)
								*tempstream = AllocateMemory(streamsize)
								If *mystream\Read(*tempstream, streamsize, @bytes) = #S_OK
									If FindMapElement(ODD(), Str(*this\hWnd)) And bytes > 0
										FID = CreateFile(#PB_Any, ODD()\Folder + fname$)
										If FID
											WriteData(FID, *tempstream, bytes)
											CloseFile(FID)
											DroppedFiles + ODD()\Folder + fname$ + " - " + FileSize(ODD()\Folder + fname$) + "bytes" + #LF$
										EndIf
									EndIf
								EndIf
								
								FreeMemory(*tempstream)
								*mystream\Release()
								*storageCopy\Release()
							EndIf
						EndIf
						
					Next i
					
					M_SEND_DROP_FILES
					GlobalUnlock_(thisStgMedium\hGlobal)
					ReleaseStgMedium_(thisStgMedium)
					
				EndIf
			EndIf
			
		EndIf
		
		
		ProcedureReturn Result
	EndProcedure
	;/////////////////////////////////////////////////////////////////////////////////
	
	Procedure SetGadgetOutlookDrop(Gadget, StorageFolder.s, MessageWindow, MessageWindowEvent)
		Protected Result, *this._IDropTarget
		
		Result = IsGadget(Gadget)
		If Result
			*this = AllocateMemory(SizeOf(_IDropTarget))
			If *this = 0
				ProcedureReturn 0
			EndIf
			
			*this\vTable = ?VTable_IDropTarget
			*this\hWnd   = GadgetID(Gadget)
			
			If *this\hWnd And RegisterDragDrop_(GadgetID(Gadget), *this) = #S_OK
				AddMapElement(ODD(), Str(GadgetID(Gadget)))
				ODD()\Gadget             = Gadget
				ODD()\MessageWindow      = MessageWindow
				ODD()\MessageWindowEvent = MessageWindowEvent
				ODD()\Folder             = StorageFolder
			Else
				Result = 0
				FreeMemory(*this)
			EndIf
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	DataSection
		VTable_IDropTarget:
		Data.i @DropTarget_QueryInterface()
		Data.i @DropTarget_AddRef()
		Data.i @DropTarget_Release()
		Data.i @DropTarget_DragEnter()
		Data.i @DropTarget_DragOver()
		Data.i @DropTarget_DragLeave()
		Data.i @DropTarget_Drop()
		
		CompilerIf Defined(IID_IUnknow, #PB_Label) = 0
			IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
			Data.l $00000000
			Data.w $0000, $0000
			Data.b $C0, $00, $00, $00, $00, $00, $00, $46
		CompilerEndIf
		
		CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
			IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
			Data.l $00000122
			Data.w $0000, $0000
			Data.b $C0, $00, $00, $00, $00, $00, $00, $46
		CompilerEndIf
	EndDataSection
	
EndModule


;/-----------------------
;|
;| Example
;|
;/-----------------------


CompilerIf #PB_Compiler_IsMainFile
	
	#Main_Window          = 0
	#ListView_0           = 0
	#PB_Event_OutlookDrop = #PB_Event_FirstCustomValue
	
	Procedure main()
		Protected *Buffer
		
		If OpenWindow(#Main_Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
			ListViewGadget(#ListView_0, 5, 5, 790, 570)
			ODD::SetGadgetOutlookDrop(#ListView_0, GetTemporaryDirectory(), #Main_Window, #PB_Event_OutlookDrop)
			
			Repeat
				Select WaitWindowEvent()
					Case #PB_Event_CloseWindow
						Break
					Case #PB_Event_OutlookDrop
						Select EventGadget()
							Case #ListView_0
								*Buffer = EventData()
								If *Buffer
								;files seperated via #LF$
									Debug PeekS(*Buffer)
									FreeMemory(*Buffer)
								EndIf
						EndSelect
				EndSelect
			ForEver
		EndIf
	EndProcedure
	
	main()
	
CompilerEndIf

Posted: **Mon Sep 17, 2018 11:22 am**

Hello,

I think I discovered a bug.

When drag and drop data from Outlook, the allocated memory for the data stream is no longer released.
This continuously increases the memory consumption of the running Exe.

PureBasic Forums - English

Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?

Re: Drag&Drop from Outlook (Express) - Possible?