here's a piece of code that combined several snippets from forum alongside some of my own code/ideas for the purpose of creating little software that will allow one to generate and display size of multiple folders on a list while allowing most of the standard Windows interaction like deleting, renaming, copying, moving, etc...
PB 5.31
Create unicode executable
Create threadsafe executable
This is a video example of how it works.
Code: Select all
EnableExplicit
Enumeration #PB_Event_FirstCustomValue
#Event_ThreadMessage
#EventType_UpdateExplorerList
#EventType_ManageGadgets
EndEnumeration
#Window = 0
#Menu = 0
#ExplorerList = 0
Global FileSizeSum.d = 0, ParentFolder$, ItemName$, NewList Files.s(), SizeModifier$ = "b", ThreadListFilesRecursive.i, WindowName$ = "Get Folder Sizes", NewMap MultipleFolders.i()
Procedure ListFilesRecursive(Dir.s, List Files.s())
Protected D
NewList Directories.s()
If Right(Dir, 1) <> "\"
Dir + "\"
EndIf
D = ExamineDirectory(#PB_Any, Dir, "")
If D <> 0
While NextDirectoryEntry(D)
Select DirectoryEntryType(D)
Case #PB_DirectoryEntry_File
AddElement(Files())
Files() = Dir + DirectoryEntryName(D)
FileSizeSum + DirectoryEntrySize(D)
Case #PB_DirectoryEntry_Directory
Select DirectoryEntryName(D)
Case ".", ".."
Continue
Default
AddElement(Directories())
Directories() = Dir + DirectoryEntryName(D)
EndSelect
EndSelect
Wend
FinishDirectory(D)
EndIf
ForEach Directories()
ListFilesRecursive(Directories(), Files())
Next
ProcedureReturn
EndProcedure
Procedure CallListFilesRecursive(*Parameter)
ListFilesRecursive(MapKey(MultipleFolders()), Files())
ProcedureReturn
EndProcedure
Procedure ControllingThread(*Parameter)
PostEvent(#Event_ThreadMessage, #Window, #PB_Ignore, #EventType_ManageGadgets, 1)
ResetMap(MultipleFolders())
ForEach (MultipleFolders())
ThreadListFilesRecursive = CreateThread(@CallListFilesRecursive(), 0)
WaitThread(ThreadListFilesRecursive)
If Len(Str(FileSizeSum)) >= 0 And Len(Str(FileSizeSum)) <= 3
ElseIf Len(Str(FileSizeSum)) >= 4 And Len(Str(FileSizeSum)) <= 6
FileSizeSum / 1024
SizeModifier$ = "kB"
ElseIf Len(Str(FileSizeSum)) >= 7 And Len(Str(FileSizeSum)) <= 9
FileSizeSum / 1048576
SizeModifier$ = "MB"
ElseIf Len(Str(FileSizeSum)) >= 10 And Len(Str(FileSizeSum)) <= 12
FileSizeSum / 1073741824
SizeModifier$ = "GB"
ElseIf Len(Str(FileSizeSum)) >= 13 And Len(Str(FileSizeSum)) <= 15
FileSizeSum / 1099511627776
SizeModifier$ = "TB"
EndIf
PostEvent(#Event_ThreadMessage, #Window, #PB_Ignore, #EventType_UpdateExplorerList, MultipleFolders())
Delay(100)
Next
PostEvent(#Event_ThreadMessage, #Window, #PB_Ignore, #EventType_ManageGadgets, 0)
ProcedureReturn
EndProcedure
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
; 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, @"Get Folder Size")
; 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
Procedure OnThreadMessage()
Select EventType()
Case #EventType_UpdateExplorerList
SetGadgetItemText(#ExplorerList, EventData(), StrD(FileSizeSum, 2) + " " + SizeModifier$, 1)
Case #EventType_ManageGadgets
If EventData() = 1
SetWindowTitle(#Window, WindowName$ + " - Working...")
DisableGadget(#ExplorerList, #True)
ElseIf EventData() = 0
SetWindowTitle(#Window, WindowName$)
DisableGadget(#ExplorerList, #False)
FileSizeSum = 0
EndIf
EndSelect
ProcedureReturn
EndProcedure
If OpenWindow(#Window, 0, 0, 500, 500, WindowName$, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
BindEvent(#Event_ThreadMessage, @OnThreadMessage())
ExplorerListGadget(#ExplorerList, 10, 10, 480, 480, "", #PB_Explorer_FullRowSelect|#PB_Explorer_MultiSelect|#PB_Explorer_NoFiles)
RemoveGadgetColumn(#ExplorerList, 1)
RemoveGadgetColumn(#ExplorerList, 1)
SetGadgetItemAttribute(#ExplorerList, #PB_Ignore, #PB_Explorer_ColumnWidth, 290, 0)
AddGadgetColumn(#ExplorerList, 1, "Folder size", 70)
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 ---"
ClearMap(MultipleFolders())
For i = 0 To CountGadgetItems(#ExplorerList)
If GetGadgetItemState(#ExplorerList, i) & #PB_Explorer_Selected
AddMapElement(MultipleFolders(), GetGadgetText(#ExplorerList) + GetGadgetItemText(#ExplorerList, i, 0))
MultipleFolders() = i
Debug GetGadgetText(#ExplorerList) + GetGadgetItemText(#ExplorerList, i, 0)
EndIf
Next
ClearList(Files())
CreateThread(@ControllingThread(), 0)
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
