Drag and Drop Shell Extension example (Windows)

El_Choni · Post by **El_Choni** » Sat Mar 19, 2005 11:50 pm

Code updated for 5.20+

Specially dedicated to Psychophanta (if you want to know what this is about, read the other Shell Extension example):

Code: Select all

Procedure Error(message$)
  wError = GetLastError_()
  If wError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, wError, 0, *ErrorBuffer, 1024, 0)
    message$+Chr(10)+PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
  MessageRequester("Error", message$)
EndProcedure


Structure ClassFactoryObject
  lpVtbl.l
  nRefCount.l
EndStructure

Global m_pDataObj.IDataObject, cmd, hModule
Global i_Unk.IUnknown, i_SEI.IShellExtInit, i_QCM.IContextMenu
Global *p_Unk.ClassFactoryObject
Global Path$

Global NewList FileList.s()

Procedure Ansi2Uni(*st, *Buffer, blen)
  If Len(PeekS(*st))<=blen
    ProcedureReturn MultiByteToWideChar_(#CP_ACP, 0, *st, -1, *Buffer, blen)
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

QueryInterface:
Procedure IUnknown_QueryInterface(*ti_unk.IUnknown, *riid.GUID, *ppvObject.LONG)
  If *ppvObject
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(GUID))
      MessageRequester("", "iunknown")
      *ppvObject\l = i_Unk
    ElseIf CompareMemory(*riid, ?IID_IShellExtInit, SizeOf(GUID))
      *ppvObject\l = i_SEI
    ElseIf CompareMemory(*riid, ?IID_IContextMenu, SizeOf(GUID))
      *ppvObject\l = i_QCM
    Else
      *ppvObject\l = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
  i_Unk\AddRef()
  ProcedureReturn #S_OK
EndProcedure

AddRef:
Procedure IUnknown_AddRef(*ti_unk.IUnknown):*p_Unk\nRefCount+1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

Release:
Procedure IUnknown_Release(*ti_unk.IUnknown):*p_Unk\nRefCount-1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

CreateInstance:
Procedure IClassFactory_CreateInstance(*ti_cf.IClassFactory, *pUnkOuter.IUnknown, *riid.GUID, *ppvObject)
  If *pUnkOuter
    ProcedureReturn #CLASS_E_NOAGGREGATION
  Else
    If i_SEI=#Null
      ProcedureReturn #E_OUTOFMEMORY
    Else
      hr = i_SEI\QueryInterface(*riid, *ppvObject)
    EndIf
  EndIf
  ProcedureReturn hr
EndProcedure

LockServer:
Procedure IClassFactory_LockServer(*ti_cf.IClassFactory, fLock)
  ProcedureReturn #E_FAIL
EndProcedure

#CF_HDROP = $0f
#DVASPECT_CONTENT = 1
#TYMED_HGLOBAL = 1
#TYMED_FILE = 2


Initialize:
Procedure IShellExtInit_Initialize(*ti_sei.IShellExtInit, *pidlFolder.ITEMIDLIST, *pdtobj.IDataObject, hkeyProgID)
  If *pidlFolder
    *m_szFile = AllocateMemory(#MAX_PATH*2)
    SHGetPathFromIDList_(*pidlFolder, *m_szFile)
    Path$ = PeekS(*m_szFile)
    FreeMemory(*m_szFile)
  EndIf
  If m_pDataObj
    m_pDataObj\Release()
  EndIf
  If *pdtobj
    m_pDataObj = *pdtobj
    *pdtobj\AddRef()
    fe.FORMATETC\cfFormat = #CF_HDROP
    fe\ptd = #Null
    fe\dwAspect = #DVASPECT_CONTENT
    fe\lindex = -1
    fe\tymed = #TYMED_HGLOBAL
    If *pdtobj\GetData(@fe, @medium.STGMEDIUM)=#S_OK
      uCount = DragQueryFile_(medium\hGlobal, -1, #Null, 0)
      *m_szFile = AllocateMemory(#MAX_PATH)
      For i=1 To uCount
        DragQueryFile_(medium\hGlobal, i-1, *m_szFile, #MAX_PATH)
        AddElement(FileList())
        FileList() = PeekS(*m_szFile)
      Next i
      FreeMemory(*m_szFile)
      ReleaseStgMedium_(@medium)
      ProcedureReturn #S_OK
    EndIf
  EndIf
  ProcedureReturn #S_FALSE
EndProcedure

#MIIM_ID = 2
#MIIM_STRING = $40
#MF_STRING = 0
#MFT_STRING = #MF_STRING
#CMF_DEFAULTONLY = 1
#MIIM_TYPE = $10

QueryContextMenu:
Procedure IContextMenu_QueryContextMenu(*i_icm.IContextMenu, hmenu, indexMenu, idCmdFirst, idCmdLast, uFlags)
  If #CMF_DEFAULTONLY&uFlags:ProcedureReturn 0:EndIf
  cmd = indexMenu
  mii.MENUITEMINFO
  mii\cbSize = SizeOf(MENUITEMINFO)
  mii\fMask = #MIIM_STRING|#MIIM_ID
  mii\fType = #MFT_STRING
  mii\wID = idCmdFirst
  mii\dwTypeData = ?CommandString
  If InsertMenuItem_(hmenu, 0, #True, @mii)=#False
    ProcedureReturn 1<<31
  EndIf
  ProcedureReturn 1
EndProcedure

Enumeration
  #GCS_VERBA
  #GCS_HELPTEXTA
  #GCS_VALIDATEA
  #GCS_VERBW
  #GCS_HELPTEXTW
  #GCS_VALIDATEW
EndEnumeration
#GCS_UNICODE = 4
#GCS_VERB = #GCS_VERBA
#GCS_HELPTEXT = #GCS_HELPTEXTA
#GCS_VALIDATE = #GCS_VALIDATEA

GetCommandString:
Procedure IContextMenu_GetCommandString(*ti_icm.IContextMenu, idCmd, uFlags, pwReserved, pszName, cchMax)
  If idCmd=cmd
    Select uFlags
      Case #GCS_HELPTEXTA ; Sets pszName To an ANSI string containing the Help text For the command.
        CopyMemory(?CommandHelpLine, pszName, Len(PeekS(?CommandHelpLine)))
      Case #GCS_HELPTEXTW ; Sets pszName To a Unicode string containing the Help text For the command.
        If Ansi2Uni(?CommandHelpLine, pszName, Len(PeekS(?CommandHelpLine)))=0
          ProcedureReturn #S_FALSE
        EndIf
      Case #GCS_VALIDATEA ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VALIDATEW ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VERBA ; Sets pszName To an ANSI string containing the language-independent command name For the menu item.
        PokeS(pszName, PeekS(?CommandString))
      Case #GCS_VERBW ; Sets pszName To a Unicode string containing the language-independent command name For the menu item.
        If Ansi2Uni(?CommandString, pszName, cchMax)=0
          ProcedureReturn #S_FALSE
        EndIf
      Default
        ProcedureReturn #S_FALSE
    EndSelect
  Else
    ProcedureReturn #S_FALSE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

Structure CMINVOKECOMMANDINFO
 cbSize.l
 fMask.l
 hwnd.l
 lpVerb.l
 lpParameters.l
 lpDirectory.l
 nShow.l
 dwHotKey.l
 hIcon.l
EndStructure

Structure CMINVOKECOMMANDINFOEX Extends CMINVOKECOMMANDINFO
 lpTitle.l
 lpVerbW.l
 lpParametersW.l
 lpDirectoryW.l
 lpTitleW.l
 ptInvoke.POINT
EndStructure

#SEE_MASK_UNICODE = $4000
#CMIC_MASK_UNICODE = #SEE_MASK_UNICODE

InvokeCommand:
Procedure IContextMenu_InvokeCommand(*ti_icm.IContextMenu, *pici.CMINVOKECOMMANDINFOEX)
  If *pici\cbSize=SizeOf(CMINVOKECOMMANDINFOEX)
    If *pici\fMask&#CMIC_MASK_UNICODE
      If (*pici\lpVerbW&$ffff)=cmd
        Show$ = Path$
        ForEach FileList()
          Show$+Chr(10)+FileList()
        Next
        MessageRequester("", Show$)
        ProcedureReturn #NOERROR
      EndIf
    ElseIf (*pici\lpVerb&$ffff)=cmd
      Show$ = Path$
      ForEach FileList()
        Show$+Chr(10)+FileList()
      Next
      MessageRequester("", Show$)
      ProcedureReturn #NOERROR
    EndIf
  ElseIf *pici\cbSize=SizeOf(CMINVOKECOMMANDINFO)
    If (*pici\lpVerb&$ffff)=cmd
      Show$ = Path$
      ForEach FileList()
        Show$+Chr(10)+FileList()
      Next
      MessageRequester("", Show$)
      ProcedureReturn #NOERROR
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

#SELFREG_E_FIRST = $80009E40
#SELFREG_E_CLASS = #SELFREG_E_FIRST+1

#GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS = 4

ProcedureDLL DllRegisterServer()
  InDLL:
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "Directory\shellex\DragDropHandlers\MyDragDropHandler.App", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{b341f32a-aa04-4569-ac04-97a6df352cf4}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "MyDragDropHandler.App\shellex\DragDropHandlers", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{b341f32a-aa04-4569-ac04-97a6df352cf4}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "{b341f32a-aa04-4569-ac04-97a6df352cf4}", 0, #REG_SZ, "FastView.Image", 15)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  *szBuffer = AllocateMemory(#MAX_PATH)
  If *szBuffer
    If ~GetModuleFileName_(?InDLL&$FFFF0000, *szBuffer, #MAX_PATH)
      GetModuleFileName_(hModule, *szBuffer, #MAX_PATH)
    EndIf
  EndIf
  If Len(PeekS(*szBuffer))
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{b341f32a-aa04-4569-ac04-97a6df352cf4}", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, "MyDragDropHandler.App", 15)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{b341f32a-aa04-4569-ac04-97a6df352cf4}\InProcServer32", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, *szBuffer, Len(PeekS(*szBuffer))+1)
    RegSetValueEx_(hKey1, "ThreadingModel", 0, #REG_SZ, "Apartment", 10)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  Else
    ProcedureReturn #SELFREG_E_CLASS
  EndIf
    If *szBuffer:FreeMemory(*szBuffer):EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllUnregisterServer()
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "Directory\shellex\DragDropHandlers\MyDragDropHandler.App")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "MyDragDropHandler.App\shellex\DragDropHandlers")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "MyDragDropHandler.App\shellex")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "MyDragDropHandler.App")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteValue_(hKey1, "{b341f32a-aa04-4569-ac04-97a6df352cf4}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{b341f32a-aa04-4569-ac04-97a6df352cf4}", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "InProcServer32")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "{b341f32a-aa04-4569-ac04-97a6df352cf4}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL AttachProcess(Instance)
  DisableThreadLibraryCalls_(Instance)
  hModule = Instance
  i_QCM = ?lpVT_IContextMenu
  i_SEI = ?lpVT_IShellExtInit
  i_Unk = ?lpVT_IUnknown
  *p_Unk = ?lpVT_IUnknown
  ProcedureReturn #True
EndProcedure

ProcedureDLL DllGetClassObject(*rclsid.GUID, *riid.GUID, *ppv.LONG)
  If *ppv
    If CompareMemory(*rclsid, ?CLSID_ContextMenuHandler, SizeOf(GUID))
      If CompareMemory(*riid, ?IID_IClassFactory, SizeOf(GUID))
        *ppv\l = ?lpVT_IClassFactory
      Else
        *ppv\l = 0
        ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
      EndIf
    Else
      *ppv\l = 0
      ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
    EndIf
  Else
    *ppv\l = 0
    ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllCanUnloadNow()
  If *p_Unk\nRefCount<=0
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

End


  
!section '.data' Data readable writeable
  lpVT_IUnknown:
  !dd l_vt_iunknown
  !dd 0 ; *p_Unk\nRefCount
  VT_IUnknown:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  lpVT_IClassFactory:
  !dd l_vt_iclassfactory
  VT_IClassFactory:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_createinstance+5
  !dd l_lockserver+2
  lpVT_IShellExtInit:
  !dd l_vt_ishellextinit
  VT_IShellExtInit:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_initialize+5
  lpVT_IContextMenu:
  !dd l_vt_icontextmenu
  VT_IContextMenu:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_querycontextmenu+5
  !dd l_invokecommand+5
  !dd l_getcommandstring+5  

DataSection ;
CLSID_ContextMenuHandler: ; {b341f32a-aa04-4569-ac04-97a6df352cf4}
Data.l $b341f32a
Data.w $aa04, $4569
Data.b $ac, $04, $97, $a6, $df, $35, $2c, $f4
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IClassFactory:
Data.l $00000001
Data.w $0, $0
Data.b $C0, $0, $0, $0, $0, $0, $0, $46
IID_IShellExtInit:
Data.l $000214E8
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
IID_IContextMenu:
Data.l $000214E4
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
CommandString:
Data.s "Show path"
CommandHelpLine:
Data.s "Shows the path"
EndDataSection

Regards,

Psychophanta · Post by **Psychophanta** » Sun Mar 20, 2005 1:11 pm

Thanx a lot

gnozal · Post by **gnozal** » Mon Mar 21, 2005 9:13 am

Thank you very much

Blade · Post by **Blade** » Mon Mar 21, 2005 10:44 pm

When I run it, nothing happens.
What I am supposed to see?

Psychophanta · Post by **Psychophanta** » Mon Mar 21, 2005 11:41 pm

Blade wrote:When I run it, nothing happens.
What I am supposed to see?

El_Choni wrote:(if you want to know what this is about, read the other Shell Extension example)

By the way, Blade: I've never seen better web :"http://www.uvlist.com/"

Thanks

Blade · Post by **Blade** » Tue Mar 22, 2005 12:27 am

Psychophanta wrote:
El_Choni wrote:(if you want to know what this is about, read the other Shell Extension example)

How could I miss such cool thread? Thanks!

Psychophanta wrote: By the way, Blade: I've never seen better web :"http://www.uvlist.com/"
Thanks

Thanks to you, despite it's a life-time project, I'm still proud of it

(BTW new editors are always welcome...)

PureBasic Forums - English

Drag and Drop Shell Extension example (Windows)

Drag and Drop Shell Extension example (Windows)

Re: Drag and Drop Shell Extension example (Windows)

Re: Drag and Drop Shell Extension example (Windows)