Code: Select all
Structure CMINVOKECOMMANDINFOEX
cbSize.l
fMask.l
hwnd.i
lpVerb.i
lpParameters.i
lpDirectory.i
nShow.l
dwHotKey.l
hIcon.i
lpTitle.i
lpVerbW.i
lpParametersW.i
lpDirectoryW.i
lpTitleW.i
ptInvoke.POINT
EndStructure
Structure QCMINFO
hmenu.i
indexMenu.l
idCmdFirst.l
idCmdLast.l
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
_alignment.l
CompilerEndIf
*pldMap.l
EndStructure
#GCS_VERBA = 0
#CMF_NORMAL = 0
#CMF_CANRENAME = 16
#DFM_MERGECONTEXTMENU = 1
#DFM_INVOKECOMMAND = 2
#DFM_GETDEFSTATICID = 14
#DFM_CMD_PROPERTIES = -5
; Win2k and newer only!
;
Prototype CDefFolderMenu_Create2(a, b, c, d, e, f, g, h, i)
Global CDefFolderMenu_Create2.CDefFolderMenu_Create2
#Window = 0
#Menu = 0
#ExplorerList = 0
; These can be changed to limit the range of menu IDs that the context menu will use
; to avoid conflicts with other menus in the program
;
#FirstShellMenuItem = 0
#LastShellMenuItem = 9999
Global CustomMenuEntry
; Callback function for the CDefFolderMenu_Create2() call
;
Procedure Callback(*psf.IShellFolder, hwnd, pdtobj.IDataObject, uMsg, wParam, lParam)
Select uMsg
Case #DFM_MERGECONTEXTMENU
; Here custom entries can be added to the created menu
;
*qcminfo.QCMINFO = lParam
If *qcminfo\idCmdLast > *qcminfo\idCmdFirst
If InsertMenu_(*qcminfo\hmenu, *qcminfo\indexMenu, #MF_BYPOSITION|#MF_STRING, *qcminfo\idCmdFirst, @"--- Custom Menu Entry ---")
; Save the ID and tell the caller that one entry was added
;
CustomMenuEntry = *qcminfo\idCmdFirst
*qcminfo\idCmdFirst + 1
EndIf
EndIf
ProcedureReturn #S_OK
Case #DFM_INVOKECOMMAND
; Here the execution of the commands can be overwritten.
; return #S_FALSE to get the default behavior
ProcedureReturn #S_FALSE
Case #DFM_GETDEFSTATICID
; return #S_FALSE to get the default handling
ProcedureReturn #S_FALSE
Default
ProcedureReturn #E_NOTIMPL
EndSelect
EndProcedure
CoInitialize_(0)
If OpenLibrary(0, "shell32.dll")
CDefFolderMenu_Create2 = GetFunction(0, "CDefFolderMenu_Create2")
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
; Win2k only exports this by ordinal, newer versions export by name
If CDefFolderMenu_Create2 = 0
CDefFolderMenu_Create2 = GetFunctionEntry(0, 701)
EndIf
CompilerEndIf
If CDefFolderMenu_Create2 = 0
Debug "Error, cannot find CDefFolderMenu_Create2()"
End
EndIf
EndIf
ShellMenu.IContextMenu = 0
If OpenWindow(#Window, 0, 0, 500, 500, "ContextMenu test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ExplorerListGadget(#ExplorerList, 10, 10, 480, 480, "C:\", #PB_Explorer_MultiSelect|#PB_Explorer_FullRowSelect|#PB_Explorer_AlwaysShowSelection)
Repeat
Event = WaitWindowEvent()
; Right-click event in the gadget
;
If Event = #PB_Event_Gadget And EventGadget() = #ExplorerList And EventType() = #PB_EventType_RightClick
; Get the IDL and IShellFolder for the current directory in the gadget
;
If SHGetDesktopFolder_(@Desktop.IShellFolder) = #S_OK
Debug "got desktop folder"
ParentFolder$ = GetGadgetText(#ExplorerList)
If Desktop\ParseDisplayName(WindowID(#Window), #Null, ParentFolder$, #Null, @*ParentIDL, #Null) = #S_OK
Debug "got parent folder idl"
If Desktop\BindToObject(*ParentIDL, #Null, ?IID_IShellFolder, @Parent.IShellFolder) = #S_OK
Debug "got parent folder object"
; Get the IDLs for all selected items
;
TotalCount = CountGadgetItems(#ExplorerList)
ItemCount = 0
For i = 0 To TotalCount-1
If GetGadgetItemState(#ExplorerList, i) & #PB_Explorer_Selected And GetGadgetItemText(#ExplorerList, i, 0) <> ".."
ItemCount + 1
EndIf
Next i
If ItemCount > 0
Dim *FileIDL(ItemCount-1)
ParsedCount = 0
For i = 0 To TotalCount-1
If GetGadgetItemState(#ExplorerList, i) & #PB_Explorer_Selected And GetGadgetItemText(#ExplorerList, i, 0) <> ".."
ItemName$ = GetGadgetItemText(#ExplorerList, i, 0)
If Parent\ParseDisplayName(WindowID(#Window), #Null, ItemName$, #Null, @*FileIDL(ParsedCount), #Null) = #S_OK
ParsedCount + 1
EndIf
EndIf
Next i
; Only go to the menu if parsing all items worked correctly
;
If ParsedCount = ItemCount
Debug "got item idl's"
; Free the old menu object
If ShellMenu
ShellMenu\Release()
ShellMenu = 0
EndIf
; Open the registry keys for shell extensions
;
KeyCount = 1
Dim KeyStrings.s(KeyCount)
Dim hKey(KeyCount)
KeyStrings(0) = "*"
; KeyStrings(1) = ".txt"
; KeyStrings(2) = "txtfile"
KeysOpen = 0
For i = 0 To KeyCount-1
If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, @KeyStrings(i), 0, #Null, 0, #KEY_READ, #Null, @hKey(KeysOpen), #Null) = #ERROR_SUCCESS
KeysOpen + 1
EndIf
Next i
; Create the menu object for our items with the above callback
;
If CDefFolderMenu_Create2(*ParentIDL, WindowID(#Window), ParsedCount, @*FileIDL(), Parent, @Callback(), KeysOpen, @hKey(), @ShellMenu.IContextMenu) = #S_OK
Debug "got menu"
; Create a PB popupmenu to put the menu items in
;
If CreatePopupMenu(#Menu)
Debug "got pb menu"
; Add the Shell menu to our popup menu
; You can specify the range of menu item ids to use here (to not conflict with others from your program)
;
If ShellMenu\QueryContextMenu(MenuID(#Menu), 0, #FirstShellMenuItem, #LastShellMenuItem, #CMF_NORMAL|#CMF_CANRENAME) >= 0
Debug "menu items added"
; Finally display the popup menu
;
DisplayPopupMenu(#Menu, WindowID(#Window))
EndIf
EndIf
EndIf
For i = 0 To KeysOpen-1
RegCloseKey_(hkey(i))
Next i
Else
Debug "error in parsing a selected item"
EndIf
; Free the item IDLs (as far as they were parsed)
;
For i = 0 To ParsedCount-1
CoTaskMemFree_(*FileIDL(i))
Next i
EndIf
Parent\Release()
EndIf
CoTaskMemFree_(*ParentIDL)
EndIf
Desktop\Release()
EndIf
; A menu event from the contextmenu range
;
ElseIf Event = #PB_Event_Menu And ShellMenu And EventMenu() >= #FirstShellMenuItem And EventMenu() <= #LastShellMenuItem
If EventMenu() = CustomMenuEntry
; Its our custom menu item
Debug "--- custom menu item selected ---"
Else
; its one of the shell items
Debug "handling event: " + Str(EventMenu())
Command$ = Space(1000)
If ShellMenu\GetCommandString(EventMenu(), #GCS_VERBA, #Null, @Command$, 1000) = #S_OK
Debug "Commmand: " + Command$
; Some of these commands can be directly passed to ShellExecute_() for example
EndIf
; Let the menu object execute this command
;
info.CMINVOKECOMMANDINFOEX\cbSize = SizeOf(CMINVOKECOMMANDINFOEX)
info\fMask = 0
info\hwnd = WindowID(#Window)
info\lpVerb = EventMenu()
info\nShow = #SW_SHOWNORMAL
err = ShellMenu\InvokeCommand(@info)
If err = #S_OK
Debug "command executed"
Else
Debug "command could not be executed. error = "+Str(err)
EndIf
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
CoUninitialize_()
End
DataSection
IID_IShellFolder: ; {000214E6-0000-0000-C000-000000000046}
Data.l $000214E6
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection