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
