Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Can you turn on the logs and look at what information it's receiving? The quality of shell change notifications has been going down for a while now. It might be the case there's not much to be done. First, they stopped sending some messages more and more in favor of Update Directory notifications. Then the even more insidious: Even simple actions spams the ever-living-f- out of you with notifications; you'll get 20 notifications of it sending 5 rename messages, a delete message, a rename (to temp name) message, then back and forth 5 times between temp names, deleting, renaming, updating, etc... all of that just on a single new file.
As you can see I already had to put in a lot of stuff to keep up with it on Windows 7; I know 10 was worse. I'd like to know how crazy the log is going on 11 before I spend a hour to set up a Win11 virtual machine again (I forgot to copy a few of my test VMs in my recent reinstall).
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I'll try to take a look at it this week but as you can see it's no easy task figuring out what's going on there... part of the issue is the TreeView can't keep up with all those messages and things get screwed up in some very difficult to understand reliably reproduce way.
Might wind up just gutting the whole notification handling system and rewriting it.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I thought I had put in a merged/timed refresh in response to SHCNE_UPDATEDIR... i.e. it receives one of those, waits a few seconds while it drops duplicate work, then does it? Is that broken? Or maybe I just did that in ucShellBrowse. Sorry, not at the computer right now, I'll try to take a look later.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Requirements
-Windows Vista or newer
ucShellTree is not compatible with Windows Vista and Windows Server 2008 R2 (based on Win7). I tested the control with both of them.
The minimum requirement is Windows 7 based on my tests.
Vista: "SHGetKnownFolderItem" isnt available in Shell32.dll
Server 2008 R2: ShellTree has stopped working:
Code:
Problem signature:
Problem Event Name: BEX
Application Name: ShellTree27.exe
Application Version: 2.7.0.11
Application Timestamp: 65bece8d
Fault Module Name: StackHash_1138
Fault Module Version: 0.0.0.0
Fault Module Timestamp: 00000000
Exception Offset: 002d19f8
Exception Code: c0000005
Exception Data: 00000008
OS Version: 6.1.7601.2.1.0.272.7
Locale ID: 1033
Additional Information 1: 1138
Additional Information 2: 1138daeae5db9a70c91913ab164ba6b3
Additional Information 3: 8a4e
Additional Information 4: 8a4e7e87c8829836cef8cbe3ebed4c0b
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Ok there's something *really* bizarre going on with oleexp.tlb and Server 2019. I installed VB6 and tried to run from IDE; I'm getting a bunch of duplicated types. In the object browser, if I select oleexp, I see one of each. But left to all, it shows two of each of everything in oleexp, both showing as in oleexp.
I can't get past a type conflict where an API inside oleexp is apparently not expect oleexp.UUID. And there's no consistency or pattern with whether it wants qualified types or not. This is likely going to be beyond my skills to resolve.
Right now the only mitigation I can offer is the twinBASIC version, which doesn't rely on oleexp.tlb, is working on it.
---
Wrote the above before I saw your comment. Glad the binaries are working; *no idea* what's up with trying to compile it from source on Server2019 though.
Which subclassing method are you using? The original self-subclassing method for VB6 would definitely trigger a DEP violation, yes, so that explains it. And why the tB version works. But the VB6 version should work if you used the same subclassing method with the helper module with DEP still on, since it lacks the memory-executed assembly thunks that DEP hates.
Last edited by fafalone; Feb 9th, 2024 at 05:59 AM.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Originally Posted by fafalone
Which subclassing method are you using? The original self-subclassing method for VB6 would definitely trigger a DEP violation, yes, so that explains it. And why the tB version works. But the VB6 version should work if you used the same subclassing method with the helper module with DEP still on, since it lacks the memory-executed assembly thunks that DEP hates.
Currently i use your original subclassing from v2.7 (ssc_Subclass). I want to switch to LaVolpe's Subclassing With Common Controls Library to avoid the crashes but im a little bit confused how to convert the following functions:
Code:
'@4
Private Sub FocusTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal TimerID As Long, ByVal Tick As Long)
KillTimer hWnd, TimerID
If hWnd = hTVD Then DoSetFocus
End Sub
'@3 - This procedure must be third to last in this module
Private Sub LabelEditWndProc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, _
ByVal lng_hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
ByRef lParamUser As Long)
'@2 - This procedure must be second to last in this module
Private Function TVSortProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal lParamSort As Long) As Long
I guess the code of this function:
Code:
'@1 - This procedure must be the last in this module
Private Sub ucWndProc(ByVal bBefore As Boolean, _
ByRef bHandled As Boolean, _
ByRef lReturn As Long, _
ByVal lng_hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long, _
ByRef lParamUser As Long)
must be placed in the new subclass function:
Code:
Private Function ISubclassEvent_ProcessMessage(ByVal Key As String, _
ByVal hWnd As Long, _
ByVal message As Long, _
wParam As Long, _
lParam As Long, _
Action As enumSubclassActions, _
WantReturnMsg As Boolean, _
ByVal ReturnValue As Long) As Long
and i have to convert the all the return values to match the different variables of the 2 sublass events...
Maybe its more easy to switch to Krools Subclassing to avoid code converting?
the function "ShellTreeSubclassProc" is a private function inside the CTL so i cant use AddressOf.
When i move the function into a module -> no more access for all the private variables of the CTL.
Any ideas how to solve this?
I guess i need a public subclassProc in a module that redirects the subclass vars to CTL function "ShellTreeSubclassProc"?
Or how can i place the function "ShellTreeSubclassProc" in a module and have access to all variables of the CTL? "Friend"?
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
You absolutely want an "ISubclass" interface that can be implemented separately wherever you need to process messages. That way, a single "SubclassProc" from a BAS module can access many subclass procs scattered all around your classes, forms or user controls.
In a BAS module:
Code:
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByVal dstObject As Long, ByVal srcObject As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function DefSubclassProc Lib "comctl32" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function SubclassWnd(hWnd As Long, vSubclass As Variant, Optional dwRefData As Long, Optional bUpdateRefData As Boolean) As Boolean
Dim Subclass As ISubclass, uIdSubclass As Long, lOldRefData As Long
If IsObject(vSubclass) Then Set Subclass = vSubclass Else vbaObjSetAddref VarPtr(Subclass), vSubclass
uIdSubclass = ObjPtr(Subclass)
If Not IsWndSubclassed(hWnd, uIdSubclass, lOldRefData) Then
SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
Else
If bUpdateRefData Then If lOldRefData <> dwRefData Then SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
End If
End Function
Private Function UnSubclassWnd(hWnd As Long, uIdSubclass As Long) As Boolean
If IsWndSubclassed(hWnd, uIdSubclass) Then UnSubclassWnd = RemoveWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass)
End Function
Private Function IsWndSubclassed(hWnd As Long, uIdSubclass As Long, Optional dwRefData As Long) As Boolean
IsWndSubclassed = GetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
End Function
Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal Subclass As ISubclass, ByVal dwRefData As Long) As Long
Dim bDiscardMessage As Boolean
Select Case uMsg
Case WM_NCDESTROY ' Remove subclassing as the window is about to be destroyed
UnSubclassWnd hWnd, ObjPtr(Subclass)
Case Else
WndProc = Subclass.WndProc(hWnd, uMsg, wParam, lParam, dwRefData, bDiscardMessage)
End Select
If Not bDiscardMessage Then WndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
ISubclass.cls interface:
Code:
Public Function WndProc(hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, dwRefData As Long, bDiscardMessage As Boolean) As Long
End Function
Now wherever you need to subclass something you just start with:
Code:
Implements ISubclass
This code is a lot simpler than LaVolpe's and eliminates the use of collection keys.
Last edited by VanGoghGaming; Feb 9th, 2024 at 08:39 AM.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Originally Posted by VanGoghGaming
You absolutely want an "ISubclass" interface that can be implemented separately wherever you need to process messages. That way, a single "SubclassProc" from a BAS module can access many subclass procs scattered all around your classes, forms or user controls.
ucShellControl uses 4 SubclassProcs with different arg's:
Code:
Public Function ShellTreeSubclassProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long, _
ByVal uIdSubclass As Long, _
ByVal dwRefData As Long) As Long
End Function
Public Sub ShellTreeFocusTimerProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal TimerID As Long, _
ByVal Tick As Long)
End Sub
Public Function ShellTreeTVSortProc(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal lParamSort As Long) As Long
End Function
Public Function ShellTreeLabelEditWndProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long, _
ByVal uIdSubclass As Long, _
ByVal dwRefData As Long) As Long
Do i have to transfer them all into the ISubclass class or how should i use these different proc's with the ISubclass user interface "WndProc"?
Do you have an example project somewhere to see the practical use of your code?
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I haven't studied the source code of ucShellControl but generally speaking you only need ONE subclass proc in each class module where you want to implement it and then you manage the code inside it using "Select Case" statements:
Code:
Private Function ISubclass_WndProc(hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, dwRefData As Long, bDiscardMessage As Boolean) As Long
Select Case hWnd ' <-- outer "Select Case" branch only needed if you subclass more than one window in this module
Case hWndMainForm ' <-- just an example name
Select Case uMsg ' <-- inner "Select Case" branch, used to filter messages of interest
Case WM_WHATEVER
' ....
Case WM_ANOTHER
' ...
End Select
Case hWndTextBox1, hWndTextBox2, hWndTextBox3 ' <-- just example names
Select Case uMsg
Case WM_WHATEVER
' ....
Case WM_ANOTHER
' ...
End Select
' ...
End Select
' If you want to prevent Windows from processing a particular message do this inside one of the "Select Case" branches:
' bDiscardMessage = True: ISubclass_WndProc = lCustomValue ' only needed if you want to return a specific value and prevent this message from being passed on
End Function
Using this format I'm sure you can combine all those four functions above into this single "Select Case" statement!
Originally Posted by Mith
Do you have an example project somewhere to see the practical use of your code?
Yes, check out the Unicode InputBox sample from my signature below, the subclassing code is very short and uncluttered so it's easy to understand. For a more complex example using the same technique you can check out my RichEdit and MsftEdit Unicode TextBox project to see the subclassing proc managing messages for multiple windows.
As far as I've seen, subclassing is a kind of "touchy" subject and everyone has developed their own style and they frown upon other methods, so ultimately it is up to you which flavor is suitable for your own taste. In the end, they all accomplish the same result.
Last edited by VanGoghGaming; Feb 9th, 2024 at 11:31 AM.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
You'll find this helpful; it's the version I prepared for tB by first re-doing the subclass procs-- it's still a VB6 project, and runs in VB6, it's what I first imported into tB to make the transition. It uses the comctl6 SetWindowSubclass method like the tB version, only redirects things through a helper module.
Had some trouble finding this version, had to dig into backups.
The key is the helper BAS contains all of the IOleIPAO stuff from Krool, and these three redirects:
Code:
Public Function ShellTreeSortCallbackProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal lParamSort As ucShellTree) As Long
ShellTreeSortCallbackProc = lParamSort.zzz_TVSortProc(lParam1, lParam2)
End Function
Public Function ShellTreeSubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As ucShellTree) As Long
ShellTreeSubclassProc = dwRefData.zzz_WndProc(hWnd, uMsg, wParam, lParam, uIdSubclass)
End Function
Public Function ShellTreeLabelEditSubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As ucShellTree) As Long
ShellTreeLabelEditSubclassProc = dwRefData.zzz_LabelEditWndProc(hWnd, uMsg, wParam, lParam, uIdSubclass)
End Function
You can use AddressOf on those since they're in the BAS, and it passes an ObjPtr to the class as the user data parameter so it can be cast as a ucShellTree variable and used to call the actual implementation in the calling instance.
----
Now with tB in the game I think there is objective reason to frown on methods using assembly thunk hacks, as those can't run in tB (some can, but ones relying on undocumented VB internals hacks can't).
Last edited by fafalone; Feb 9th, 2024 at 11:37 AM.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Is subclassing done differently in tB since you mentioned a "tB version"? Is it because tB can use the "AddressOf" operator with class methods, right? That surely does come in handy...
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Not just that, but self-subclassing techniques like the one originally used in the VB6 version (Paul Caton/LaVolpe ssc_Subclass), rely on assembly thunks that use undocument internal VB implementation hacks. Since tB isn't a just a reverse engineered VB, the internals differ, so the the self-sub thunks can't be used.
However tB supporting AddressOf on classes natively eliminates the need for such a hack, so you can replace it with more simple methods like SetWindowSubclass and direct callbacks. I did write a tB FAQ entry that clarifies that 'full compatibility' doesn't include undocumented internal implementation details.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Originally Posted by fafalone
The key is the helper BAS contains all of the IOleIPAO stuff from Krool, and these three redirects:
Code:
Public Function ShellTreeSortCallbackProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal lParamSort As ucShellTree) As Long
ShellTreeSortCallbackProc = lParamSort.zzz_TVSortProc(lParam1, lParam2)
End Function
Public Function ShellTreeSubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As ucShellTree) As Long
ShellTreeSubclassProc = dwRefData.zzz_WndProc(hWnd, uMsg, wParam, lParam, uIdSubclass)
End Function
Public Function ShellTreeLabelEditSubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As ucShellTree) As Long
ShellTreeLabelEditSubclassProc = dwRefData.zzz_LabelEditWndProc(hWnd, uMsg, wParam, lParam, uIdSubclass)
End Function
You can use AddressOf on those since they're in the BAS, and it passes an ObjPtr to the class as the user data parameter so it can be cast as a ucShellTree variable and used to call the actual implementation in the calling instance.
Krool's subclassing works now with ucShellTree!
I also had to add another subclassing function for the FocusTimer:
Code:
CTL:
Public Function zzz_FocusTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal TimerID As Long, ByVal Tick As Long) As Long
MOD:
Public Function ShellTreeFocusTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal TimerID As Long, ByVal Tick As Long, ByVal lFocusTimer As ucShellTree)
ShellTreeFocusTimerProc = lFocusTimer.zzz_FocusTimerProc(hWnd, uMsg, TimerID, Tick)
End Function
ucShellTree runs now without crashes on Windows Server editions with a strict DEP option.
I tested the LabelEdit with a file and the IDE/exe is crashing when i rename the file.
The crash happens in the RenameFile function.
No crash occurred if i enter the label edit mode and not rename the file.
I guess this has something to do with the subclassing.
With ucShellTree v2.7 you unsubclassed the edit control at the beginning of TVN_ENDLABELEDITW in the function "ucWndProc".
The newer version do the unsubclass in the function "zzz_LabelEditWndProc" at WM_DESTROY.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
At Windows Server 2008 R2 i want to open the existing path "C:\Users\Administrator\AppData\Local\Temp\1" using ucTree.OpenToPath but it doesnt work because the folder "AppData" is hidden in the tree:
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I guess i found the problem: in the function TVExpandFolder at line "siParent.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, pEnum" you init the enum object to get all items from a parent folder but i cant find the settings for the enum object using "STR_ENUM_ITEMS_FLAGS".
STR_ENUM_ITEMS_FLAGS
Introduced in Windows 8. Specifies a SHCONTF value to be passed to IShellFolder::EnumObjects when you call IShellItem::BindToHandler with BHID_EnumItems.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
It seems the shell item enums do work differently on the server editions; the initial enum doesn't include the hidden items like regular editions.
I was already writing that bind context function to test that out (I found out I didn't have *any* PSPropertyBag_ APIs written so I got distracted by that; so won't get around to testing until tomorrow now)... but the problem is that's only good for Windows 8 and up. 7 is still pretty popular among VB6 users.
The other method is just falling back to IShellFolder/IEnumIDList, which has its own drawbacks.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
If you don't need Win7 then yeah, bind context is a good option. But I couldn't do that for the main release except as maybe an optional that just proceeded normally if the call failed with the bindctx.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Originally Posted by fafalone
If you don't need Win7 then yeah, bind context is a good option. But I couldn't do that for the main release except as maybe an optional that just proceeded normally if the call failed with the bindctx.
IF Win8 or Higher = True THEN use bindctx ELSE fall back to current standard
or add a new property like "ShowSuperMegaHiddenItems" that is available with Win8 or higher
ShowSuperMegaHiddenItems = false ' use the current standard
ShowSuperMegaHiddenItems = True ' use bindctx
btw, all my apps support Win7/Server2008R2 or higher.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Bad news I'm afraid... I got the bind context working fine; I tested it with include only folders and sure enough no files were enumerated. But it ignored the include hidden/superhidden flags, even while running as admin. I suspect there's a policy setting somewhere that's controlling this.
I didn't add conditionals since it was just a preliminary test;
Code:
Public Declare PtrSafe Function CreateBindCtx Lib "ole32" (ByVal reserved As Long, ppbc As IBindCtx) As Long
Public Declare PtrSafe Function PSCreateMemoryPropertyStore Lib "propsys" (riid As UUID, ppv As Any) As Long
Public Declare PtrSafe Function PSPropertyBag_WriteDWORD Lib "propsys" (ByVal propBag As IPropertyBag, ByVal propName As LongPtr, ByVal value As Long) As Long
Dim pbc As IBindCtx
Dim hrbc As Long: hrbc = CreateBindCtx(0, pbc)
If (pbc Is Nothing) = False Then
Dim sppb As IPropertyBag
Dim spunk As IUnknownUnrestricted 'oleexp.IUnknown in VB6
hrbc = PSCreateMemoryPropertyStore(IID_IUnknown, spunk)
If SUCCEEDED(hrbc) Then
pbc.RegisterObjectParam StrPtr(STR_PROPERTYBAG_PARAM), spunk
Set sppb = spunk
If (sppb Is Nothing) = False Then
PSPropertyBag_WriteDWORD sppb, StrPtr(STR_ENUM_ITEMS_FLAGS), SHCONTF_FOLDERS Or SHCONTF_INCLUDEHIDDEN Or SHCONTF_INCLUDESUPERHIDDEN
Debug.Print "Wrote BindCtx dw"
Else
Debug.Print "QI for PropertyBag failed"
End If
Else
Debug.Print "PSCreateMemPstore failed"
End If
siParent.BindToHandler ObjPtr(pbc), BHID_EnumItems, IID_IEnumShellItems, pEnum
Else
siParent.BindToHandler 0, BHID_EnumItems, IID_IEnumShellItems, pEnum
End If
The only alternative I can see at this point is toggling the explorer setting; I doubt IShellFolder would help here since SHCONTF flags are being ignored, and other enum methods wouldn't work with all the virtual objects like ThisPC. It would be possible to do like ucShellBrowse and have a different enum method available only for regular file system paths, but that's major rewrite territory; I'd be inclined to just tell users ucShellTree respects your settings here, deal with it. You could offer to toggle it permanently or per-run; if you're considering per-enum then I'd check whether changing it triggers a refresh of open windows; that could really interfere with the smoothness of it.
Last edited by fafalone; Feb 10th, 2024 at 06:28 PM.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Originally Posted by fafalone
Bad news I'm afraid... I got the bind context working fine; I tested it with include only folders and sure enough no files were enumerated. But it ignored the include hidden/superhidden flags, even while running as admin. I suspect there's a policy setting somewhere that's controlling this.
Check this code to use hidden/superhidden flags:
Code:
...
hr = SHCreateItemFromIDList(pidlRoot, IID_IShellItem, pISI)
hr = pISI.BindToHandler(0, BHID_SFObject, IID__IShellFolder, pISF)
hr = pISF.EnumObjects(0, SHCONTF_CHECKING_FOR_CHILDREN Or SHCONTF_ENABLE_ASYNC Or SHCONTF_FASTITEMS Or SHCONTF_FLATLIST Or _
SHCONTF_FOLDERS Or SHCONTF_INCLUDEHIDDEN Or SHCONTF_INCLUDESUPERHIDDEN Or SHCONTF_INIT_ON_FIRST_NEXT Or _
SHCONTF_NAVIGATION_ENUM Or SHCONTF_NETPRINTERSRCH Or SHCONTF_NONFOLDERS Or SHCONTF_SHAREABLE Or _
SHCONTF_STORAGE, pEIDL)
If hr = S_OK Then
Do While pEIDL.Next(1, pidlEnum, 0) = S_OK
...
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I tried to test the other enum method but BindToHandler returns always -2147467262 and i get no IShellFolder object.
Maybe my def of IID_IShellFolder is wrong?
Code:
Private Function IID_IShellFolder() As oleexp.UUID
'{000214E6-0000-0000-C000-000000046}
Static iid As oleexp.UUID
If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H214E6, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
IID_IShellFolder = iid
End Function
new enum method:
Code:
If (siParent Is Nothing) = False Then
Dim pISF As oleexp.IShellFolder
Dim pEIDL As oleexp.IEnumIDList
Dim pidlEnum As Long
Dim lReturn As Long
lReturn = siParent.BindToHandler(0&, BHID_SFUIObject, IID_IShellFolder, pISF) ' returns -2147467262
If (pISF Is Nothing) = False Then
lReturn = pISF.EnumObjects(UserControl.hWnd, SHCONTF_CHECKING_FOR_CHILDREN Or _
SHCONTF_FOLDERS Or _
SHCONTF_NONFOLDERS Or _
SHCONTF_INCLUDEHIDDEN Or _
SHCONTF_SHAREABLE Or _
SHCONTF_STORAGE Or _
SHCONTF_NAVIGATION_ENUM Or _
SHCONTF_FASTITEMS Or _
SHCONTF_INCLUDESUPERHIDDEN, _
pEIDL)
End If
If (pEIDL Is Nothing) = False Then
bFilling = True
tc1 = GetTickCount()
Do While pEIDL.Next(1&, pidlEnum, pcl) = S_OK
oleexp.SHCreateItemFromIDList pidlEnum, IID_IShellItem, siChild
the above code replaced the original code:
Code:
siParent.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, pEnum
If (pEnum Is Nothing) = False Then
bFilling = True
tc1 = GetTickCount()
Do While pEnum.Next(1&, siChild, pcl) = S_OK
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I fixed the problem with the error at BindToHandler: the other enum method uses BHID_SFObject with BindToHandler but the ucShellTree project doesnt know about this UUID. I can only chosse between BHID_DataObject, BHID_EnumItems and BHID_SFUIObject.
I added BHID_SFObject to solve the error:
Code:
Private Function BHID_SFObject() As oleexp.UUID
'https://doxygen.reactos.org/d0/d95/shlguid_8h.html
'DEFINE_GUID (BHID_SFObject, 0x3981E224, 0xF559, 0x11D3, 0x8E, 0x3A, 0x00, 0xC0, 0x4F, 0x68, 0x37, 0xD5)
Static iid As oleexp.UUID
If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H3981E224, CInt(&HF559), CInt(&H11D3), &H8E, &H3A, &H0, &HC0, &H4F, &H68, &H37, &HD5)
BHID_SFObject = iid
End Function
Now i can run ucShellTree with the other enum method and the content of the desktop is fully enumerated and looks correct BUT:
- "This PC" is enumerated but only showing empty item names and the standard file icon.
- I can expand my HD drive D: but some folders (with subfolders) on this drive cannot expanded.
- i cannot expand my HD drive F: ...
Strange behavior...
I wish i could see my C: drive in the tree to test if the hidden AppData folder is now visible or not!
For me it looks like this enum method only works with real folders but not with GUID items.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
I'm 99% sure IEnumShellItems is just implementing IShellFolder/IEnumIDList under the hood. As expected, it too ignored those flags. Not sure where you're going wrong, must be with the IIDs (I strongly advise against copying code from nebeln; he's had IID issues and others from his weird need to rewrite everything to avoid doing it the same way as me and all the giants I learned from). If you want to try yourself:
Code:
Public Declare Function ILCombine Lib "shell32" (ByVal pidl1 As LongPtr, ByVal pidl2 As LongPtr) As LongPtr
Public Function BHID_SFObject() As UUID
'{0x3981E224, 0xF559, 0x11D3, 0x8E,0x3A, 0x00,0xC0,0x4F,0x68,0x37,0xD5}
Static iid As UUID
If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H3981E224, &HF559, &H11D3, &H8E, &H3A, &H0, &HC0, &H4F, &H68, &H37, &HD5)
BHID_SFObject = iid
End Function
Public Function IID_IShellFolder() As UUID
Static iid As UUID
If (iid.Data1 = 0) Then Call DEFINE_OLEGUID(iid, &H214E6, 0, 0)
IID_IShellFolder = iid
End Function
Public Sub DEFINE_OLEGUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer)
DEFINE_UUID Name, L, w1, w2, &HC0, 0, 0, 0, 0, 0, 0, &H46
End Sub
Dim psfp As IShellFolder
Dim peil As IEnumIDList
Dim pidlEnum As LongPtr
Dim pidlPar1 As LongPtr
Dim ppil As IPersistIDList
Set ppil = siParent
ppil.GetIDList pidlPar
Dim hrbh As Long: hrbh = siParent.BindToHandler(0, BHID_SFObject, IID_IShellFolder, psfp)
If (psfp Is Nothing) = False Then
psfp.EnumObjects 0, SHCONTF_FOLDERS Or SHCONTF_INCLUDEHIDDEN Or SHCONTF_INCLUDESUPERHIDDEN, peil
Else
Debug.Print "Failed to get IShellFolder for siParent; 0x" & Hex$(hrbh)
Exit Sub
End If
If (peil Is Nothing) = False Then
bFilling = True
tc1 = GetTickCount()
Do While peil.Next(1&, pidlEnum, pcl) = S_OK
SHCreateItemFromIDList ILCombine(pidlPar, pidlEnum), IID_IShellItem, siChild
Note: That code is just to test whether the flags work; it's light on error handling and heavy on memory leaks.
Edit: You ninja'd me by a few minutes. Your new problems likely come from the other problem your code had you didn't get to yet; IEnumIDList gives relative pidls, you need to combine them with the pidl of the parent you're enumerating.
Last edited by fafalone; Feb 10th, 2024 at 09:46 PM.
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Originally Posted by fafalone
Edit: You ninja'd me by a few minutes. Your new problems likely come from the other problem your code had you didn't get to yet; IEnumIDList gives relative pidls, you need to combine them with the pidl of the parent you're enumerating.
Great, it works now!
The hidden AppData folder is now visible!
Replace this in TVExpandFolder:
Code:
siParent.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, pEnum
If (pEnum Is Nothing) = False Then
bFilling = True
tc1 = GetTickCount()
Do While pEnum.Next(1&, siChild, pcl) = S_OK
with this:
Code:
Dim pISF As oleexp.IShellFolder
Dim pEIDL As oleexp.IEnumIDList
Dim pidlEnum As Long
Dim lReturn As Long
Dim ppil As IPersistIDList
Set ppil = siParent
ppil.GetIDList pidlPar
lReturn = siParent.BindToHandler(0&, BHID_SFObject, IID_IShellFolder, pISF)
If (pISF Is Nothing) = False Then
lReturn = pISF.EnumObjects(0, _
SHCONTF_CHECKING_FOR_CHILDREN Or _
SHCONTF_FOLDERS Or _
SHCONTF_NONFOLDERS Or _
SHCONTF_INCLUDEHIDDEN Or _
SHCONTF_SHAREABLE Or _
SHCONTF_STORAGE Or _
SHCONTF_NAVIGATION_ENUM Or _
SHCONTF_FASTITEMS Or _
SHCONTF_INCLUDESUPERHIDDEN, _
pEIDL)
End If
If (pEIDL Is Nothing) = False Then
bFilling = True
tc1 = GetTickCount()
Do While pEIDL.Next(1&, pidlEnum, pcl) = S_OK
oleexp.SHCreateItemFromIDList ILCombine(pidlPar, pidlEnum), IID_IShellItem, siChild
Other necessary code addings:
Code:
Private Function IID_IShellFolder() As oleexp.UUID
'{000214E6-0000-0000-C000-000000046}
Static iid As oleexp.UUID
If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H214E6, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
IID_IShellFolder = iid
End Function
Private Function BHID_SFObject() As oleexp.UUID
'https://doxygen.reactos.org/d0/d95/shlguid_8h.html
'DEFINE_GUID (BHID_SFObject, 0x3981E224, 0xF559, 0x11D3, 0x8E, 0x3A, 0x00, 0xC0, 0x4F, 0x68, 0x37, 0xD5)
Static iid As oleexp.UUID
If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H3981E224, CInt(&HF559), CInt(&H11D3), &H8E, &H3A, &H0, &HC0, &H4F, &H68, &H37, &HD5)
BHID_SFObject = iid
End Function
Originally Posted by fafalone
Reply With Quote
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
(some can, but ones relying on undocumented VB internals hacks can't).
Re: [VB6] ucShellTree - Full-featured Shell Tree UserControl
