[VB6] ucShellBrowse: A modern replacement for Drive/FileList w/ extensive features

[Crapahute]

Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Command1_Click()
MsgBox "" & Shell("D:\Test\ucShellBrowse\Demo2\Project4.exe", vbNormalFocus)
End Sub

Private Sub Command2_Click()
MsgBox "" & ShellExecute(0, "open", "D:\Test\ucShellBrowse\Demo2\Project4.exe", vbNullString, vbNullString, 0)
End Sub

In IDE I got 11672 for shell and 42 for ShellExecute with Project4.exe not showing.

When compiled, I got 12148 and 42 with Project4.exe executing as expected.

I tried on a Windows7 machine, and it works in the IDE as it should. I will try on other machines next week.

EDIT : I tried on a Windows 10 machine and it works in the IDE. Must be my main machine under Windows 11 which has a problem...

[fafalone]

Did you try with other programs? Very curious to see if this is specific to ucShellBrowse or maybe the demo program.

Those numbers indicate success (For shell, anything nonzero, and for ShellExecute, anything >32, is success according to MSDN). Did you look in task manager to see if it's running, just not showing the window?

One other possibility is Defender or another AV interfering, though they should have gave you a notice about it.

[Crapahute]

Yes I tried with my own programs which use your ucShellBrowse.

I have investigated a bit further.

Looking in ucShellBrowse.ctl I remerbered that I had to make changes to make it work in the IDE. What I did at the time is
change :

Private Const mDefHighPerfMode As Boolean = True

in

Private mDefHighPerfMode As Boolean

and add in UserControl_Initialize

If IsIDE = True Then
    mDefHighPerfMode = False
Else
    mDefHighPerfMode = True
End If

With these changes, the program works in the IDE and when it's compiled. Without, it crashes the IDE.

But when I compile and run it from the IDE with Shell/ShellExecute, it doesn't work. It crashes whenever a form with ucShellBrowse object is open.

I tried to change IsIDE with InIDE by adding this function :

Private Function InIDE(Optional ByRef b As Boolean = True) As Boolean
If b = True Then Debug.Assert Not InIDE(InIDE) Else b = True
End Function

with no luck.

Then I forced

mDefHighPerfMode = False

and there, the program works when run from the IDE (Shell and ShellExecute). So my problem is about mDefHighPerfMode. When false it works all the time. With my patch it also works except when launched from the IDE.

[fafalone]

High performance mode shouldn't be crashing the IDE to begin with... perhaps the issue is it that is *is* executing, but crashing out on load? You can enable printing debug output to a file, by changing dbg_PrintToFile to True, so you can view the log from the exe like you would in the IDE.

The only thing I remember is there was some Windows 11 issue with one of the Unicode functions... In FindFirstFileNt, the first fewlines after the Dims should be

        strFolder = "\??\"
        strFolder = strFolder & strDirectory
    '    RtlDosPathNameToNtPathName_U StrPtr(strFolder), strUnicode, fp, rn
        RtlInitUnicodeString strUnicode, StrPtr(strFolder)

with RtlDosPathNameToNtPathName_U commented out like that... I think there's where the problem was.

[darjeeling]

Hi Crapahute

mDefHighPerfMode = False seems to be THE SOLUTION !

Thank you

[Crapahute]

        strFolder = "\??\"
        strFolder = strFolder & strDirectory
    '    RtlDosPathNameToNtPathName_U StrPtr(strFolder), strUnicode, fp, rn
        RtlInitUnicodeString strUnicode, StrPtr(strFolder)

with RtlDosPathNameToNtPathName_U commented out like that... I think there's where the problem was.

The code you provide is already set like that, I did not touch anything.

[Crapahute]

Here is the 'log' I get. When launched from IDE with Shell, the program (Demo\ShellBrowse-v111-RC1-Std01.exe) crashes after the last line :

UserControl_Initialize
DebugAppend UCSB Initialize Entry at 04/03/24 10:32:31 0
DebugAppend dpix=1 0
DebugAppend Initializing Rating column 0
DebugAppend PBEncodedPNGtoHIML hr=0 0
DebugAppend PBEncodedPNGtoHIML hr=1 0
DebugAppend PBEncodedPNGtoHIML hr=2 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Ordinateur, icon=shell32.dll#0016 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Intranet local, icon=shell32.dll#0018 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites de confiance, icon=inetcpl.cpl#00004480 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Internet, icon=inetcpl.cpl#001313 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites sensibles, icon=inetcpl.cpl#00004481 0
DebugAppend -->UC_INIT_OUT 0
Exit Sub
DebugAppend ScaledDtFontHeight=13 444
DebugAppend FontDetailsPropset DtFont=218771098 444
DebugAppend ReadLVFont Tahoma 444
DebugAppend SetFontFileControls Tahoma,hLVS=0 444
DebugAppend ReadProp ViewMode=1 0
DebugAppend -->PvCreate 0
DebugAppend ComCtlDGV hr=0x0 0
DebugAppend ComCtl major=6,minor=16 0
DebugAppend Initializing Display Columns... 0
DebugAppend SYSTEM.FILENAME: 0x41CF5AE0,0xF75A,last=0xB9,pid=100 0
DebugAppend Added 1690 columns 0
DebugAppend pvCreateCombo() 3
DebugAppend pvCreateCombo cyCombo=26 0
DebugAppend Set Font->Size=8,25 0
DebugAppend SetFont.Out cyCombo=26 0
DebugAppend dpix=1 0
DebugAppend color=&H0 0
DebugAppend lvrEnable=Vrai 0
DebugAppend Ambient.UserMode=Faux 0
DebugAppend Exit UC_SHow, LastSessionPath= 0
UserControl_Initialize
DebugAppend UCSB Initialize Entry at 04/03/24 10:32:31 0
DebugAppend dpix=1 0
DebugAppend Initializing Rating column 0
DebugAppend PBEncodedPNGtoHIML hr=0 0
DebugAppend PBEncodedPNGtoHIML hr=1 0
DebugAppend PBEncodedPNGtoHIML hr=2 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Ordinateur, icon=shell32.dll#0016 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Intranet local, icon=shell32.dll#0018 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites de confiance, icon=inetcpl.cpl#00004480 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Internet, icon=inetcpl.cpl#001313 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites sensibles, icon=inetcpl.cpl#00004481 0
DebugAppend -->UC_INIT_OUT 0
Exit Sub
DebugAppend ScaledDtFontHeight=13 444
DebugAppend FontDetailsPropset DtFont=218771499 444
DebugAppend ReadLVFont Tahoma 444
DebugAppend SetFontFileControls Tahoma,hLVS=0 444
DebugAppend ReadProp ViewMode=1 0
DebugAppend -->PvCreate 0
DebugAppend ComCtlDGV hr=0x0 0
DebugAppend ComCtl major=6,minor=16 0
DebugAppend Initializing Display Columns... 0
DebugAppend SYSTEM.FILENAME: 0x41CF5AE0,0xF75A,last=0xB9,pid=100 0
DebugAppend Added 1690 columns 0
DebugAppend pvCreateCombo() 3
DebugAppend pvCreateCombo cyCombo=26 0
DebugAppend Set Font->Size=8,25 0
DebugAppend SetFont.Out cyCombo=26 0
DebugAppend dpix=1 0
DebugAppend color=&H0 0
DebugAppend lvrEnable=Vrai 0
DebugAppend Ambient.UserMode=Faux 0
DebugAppend Exit UC_SHow, LastSessionPath= 0
DebugAppend WriteLVFont Tahoma 444
DebugAppend UserControl_WriteProperties() 1
DebugAppend WriteLVFont Tahoma 444
DebugAppend UserControl_WriteProperties() 1
DebugAppend terminate event 0
DebugAppend terminate event 0
UserControl_Initialize
DebugAppend UCSB Initialize Entry at 04/03/24 10:32:32 0
DebugAppend dpix=1 0
DebugAppend Initializing Rating column 0
DebugAppend PBEncodedPNGtoHIML hr=0 0
DebugAppend PBEncodedPNGtoHIML hr=1 0
DebugAppend PBEncodedPNGtoHIML hr=2 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Ordinateur, icon=shell32.dll#0016 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Intranet local, icon=shell32.dll#0018 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites de confiance, icon=inetcpl.cpl#00004480 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Internet, icon=inetcpl.cpl#001313 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites sensibles, icon=inetcpl.cpl#00004481 0
DebugAppend -->UC_INIT_OUT 0
Exit Sub
DebugAppend ScaledDtFontHeight=17 444
DebugAppend FontDetailsPropset DtFont=705310523 444
DebugAppend ReadLVFont Comic Sans MS 444
DebugAppend SetFontFileControls Comic Sans MS,hLVS=0 444
DebugAppend ReadProp ViewMode=1 0
DebugAppend -->PvCreate 0
DebugAppend ComCtlDGV hr=0x0 0
DebugAppend ComCtl major=6,minor=16 0
DebugAppend Initializing Display Columns... 0
DebugAppend SYSTEM.FILENAME: 0x41CF5AE0,0xF75A,last=0xB9,pid=100 0
DebugAppend Added 1690 columns 0
DebugAppend pvCreateCombo() 3
DebugAppend pvCreateCombo cyCombo=31 0
DebugAppend InitLV Viewmode=1 0
DebugAppend InitLV set view LVS_ICON 4
DebugAppend InitLV->hLVSHdr=1642922 0
DebugAppend InitLV->cnt=4 0
DebugAppend Set Font->Size=9 0
DebugAppend SetFont.Out cyCombo=31 0
DebugAppend dpix=1 0
DebugAppend color=&H0 0
DebugAppend lvrEnable=Vrai 0
DebugAppend Ambient.UserMode=Faux 0
DebugAppend Exit UC_SHow, LastSessionPath= 0
UserControl_Initialize
DebugAppend UCSB Initialize Entry at 04/03/24 10:32:58 0
DebugAppend dpix=1 0
DebugAppend Initializing Rating column 0
DebugAppend PBEncodedPNGtoHIML hr=0 0
DebugAppend PBEncodedPNGtoHIML hr=1 0
DebugAppend PBEncodedPNGtoHIML hr=2 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Ordinateur, icon=shell32.dll#0016 0
DebugAppend LastError=0x0 0
DebugAppend Added Zone Intranet local, icon=shell32.dll#0018 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites de confiance, icon=inetcpl.cpl#00004480 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Internet, icon=inetcpl.cpl#001313 0
DebugAppend LastError=0x1 0
DebugAppend Added Zone Sites sensibles, icon=inetcpl.cpl#00004481 0
DebugAppend -->UC_INIT_OUT 0
Exit Sub
DebugAppend ScaledDtFontHeight=17 444
DebugAppend FontDetailsPropset DtFont=17445101 444
DebugAppend ReadLVFont Comic Sans MS 444
DebugAppend SetFontFileControls Comic Sans MS,hLVS=0 444
DebugAppend ReadProp ViewMode=1 0
DebugAppend -->PvCreate 0
DebugAppend ComCtlDGV hr=0x0 0
DebugAppend ComCtl major=6,minor=16 0
DebugAppend Initializing Display Columns... 0
DebugAppend SYSTEM.FILENAME: 0x41CF5AE0,0xF75A,last=0xB9,pid=100 0
DebugAppend Added 1690 columns 0
DebugAppend pvCreateCombo() 3
DebugAppend Got NFMT on ucWndProc main 0
DebugAppend pvCreateCombo cyCombo=31 0
DebugAppend EnumRoot::SetRoot=Desktop 2
DebugAppend Got siDesk 0
DebugAppend EnumRoot::sName=Bureau 0
DebugAppend Insertitem n=Bureau,i=34 0
DebugAppend Insert n=Ce PC,full=::{20D04FE0-3AEA-1069-A2D8-08002B30309D} 0
DebugAppend Insert n=xxxx (xxxx),full=::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\uuid:a74ff7f3-4452-4f8f-98f1-836957945ebd 0
DebugAppend Insert n=Install (xxxx),full=::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\uuid:7a366a15-ac7e-494a-be32-71ea7c702b57 0
DebugAppend Insert n=Test (xxxx),full=::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\uuid:6e0ba2f8-39d4-4f80-99ee-770d9e46137c 0
DebugAppend Insert n=Windows (C,full=C:\ 0
DebugAppend Insert n=DOCUMENTS (D,full=D:\ 0
DebugAppend Insert n=DATA2 (E,full=E:\ 0
DebugAppend Insert n=PRG (G,full=G:\ 0
DebugAppend Insert n=Corbeille,full=::{645FF040-5081-101B-9F08-00AA002F954E} 0
DebugAppend Insert n=Panneau de configuration,full=::{26EE0668-A00A-44D7-9371-BEB064C98683} 0
DebugAppend Insert n=xxxx,full=C:\Users\xxxx 0
DebugAppend Insert n=Biblioth ques,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5} 0
DebugAppend Insert n=Musique,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\Music.library-ms 0
DebugAppend Insert n=Images enregistr es,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\SavedPictures.library-ms 0
DebugAppend Insert n=Vid os,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\Videos.library-ms 0
DebugAppend Insert n=Pellicule,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\CameraRoll.library-ms 0
DebugAppend Insert n=Documents,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\Documents.library-ms 0
DebugAppend Insert n=Images,full=::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\Pictures.library-ms 0
DebugAppend Insert n=R seau,full=::{F02C1A0D-BE21-4350-88B0-7367FC96EF3C} 0
DebugAppend Insert n=OneDrive,full=C:\Users\xxxx\OneDrive 0
DebugAppend Insert n=Dropbox,full=G:\Dropbox 0
DebugAppend Insert n=Musique,full=D:\xxxx\Music 0
DebugAppend Insert n=T l chargements,full=D:\Downloads 0
DebugAppend Insert n=Images,full=D:\xxxx\Pictures 0
DebugAppend Insert n=Vid os,full=D:\xxxx\Videos 0
DebugAppend Insert n=Documents,full=D:\xxxx\Documents 0
DebugAppend Insert n=Bureau,full=C:\Users\xxxx\Desktop 0
DebugAppend Insert n=Accueil,full=::{F874310E-B6B7-47DC-BC84-B9E6B38F5903} 0
DebugAppend Insert n=Galerie,full=::{E88865EA-0E1C-4E20-9AA6-EDCD0212C87C} 0
DebugAppend Insert n=Images,full=D:\xxxx\Pictures 0
DebugAppend Insert n=Dev,full=C:\Users\xxxx\Desktop\Dev 0
DebugAppend Insert n=Graphisme,full=C:\Users\xxxx\Desktop\Graphisme 0
DebugAppend Insert n=Utilitaires,full=C:\Users\xxxx\Desktop\Utilitaires 0
DebugAppend Insert n=WIP,full=C:\Users\xxxx\Desktop\WIP 0
DebugAppend Got NFMT on ucWndProc main 0
DebugAppend InitLV Viewmode=1 0
DebugAppend InitLV set view LVS_ICON 4
DebugAppend Got NFMT on ucWndProc main 0
DebugAppend Set Font->Size=9 0
DebugAppend SetFont.Out cyCombo=31 0
DebugAppend Subclass LV, h=71034 0
DebugAppend Got NFMT on ucWndProc main 0
DebugAppend Got NFMT on ucWndProc main 0
DebugAppend InitLV->hLVSHdr=71036 0
DebugAppend InitLV->cnt=4 0
DebugAppend SwitchView 1|1, bForcedDFS=Faux 0
DebugAppend cxyDispL=96 11
DebugAppend SwitchView::StandardSet,vw=1 0
DebugAppend SwitchView::CRITTEST, sending LVM_SETVIEW 0
DebugAppend LVM_SETVIEW 0x1 0
DebugAppend UserControl_Show::LVLoadFolder 0
DebugAppend LVLoadFolder->Using high performance loader for d:\test\Demo 23
DebugAppend ucShellBrowse.LVLoadFolderEx d:\test\Demo,m_sCurPath=d:\test\Demo,sPrevPath=,GrpMode=0 2
DebugAppend ResetSpecialCols() 0
DebugAppend ResetSpecialCols, m_SubItemProgress=0 0
DebugAppend PathAttrib=SFGAO_CANCOPY,SFGAO_CANDELETE,SFGAO_CANLINK,SFGAO_CANMOVE,SFGAO_CANRENAME,SFGAO_DROPTARGE T,SFGAO_FILESYSANCESTOR,SFGAO_FILESYSTEM,SFGAO_FOLDER,SFGAO_HASPROPSHEET,SFGAO_STORAGE,SFGAO_STORAGE ANCESTOR, 0
DebugAppend In Computer, trying catprovider 0
DebugAppend Got IShellFolder2 0
DebugAppend Got category provider 0
DebugAppend guid={00000000-0000-0000-0000-000000000000} 0
DebugAppend LVLoadFolderEx::No category support (SCID=NULL) 0
DebugAppend LVLoadFolderEx::Start main loop... 0

[Crapahute]

To be comlete, that's what I did to get the log :

private Sub PrintLog(s As String)
Dim n As Long
    n = FreeFile
    Open "d:\test\test.txt" For Append As #n
    Print #n, s
    Close #n
End Sub

Private Sub DebugAppend(ByVal sMsg As String, Optional ilvl As Long = 0)

PrintLog "DebugAppend " & sMsg & " " & ilvl

If ilvl < dbg_MinLevel Then Exit Sub
If dbg_IncludeDate Then sMsg = "[" & Format$(Now, dbg_dtFormat) & "] " & sMsg
If dbg_PrintToImmediate Then Debug.Print sMsg
If dbg_RaiseEvent = True Then RaiseEvent DebugMessage(sMsg, CInt(ilvl))
If dbg_PrintToFile Then
    If log_hFile Then
        WriteLog sMsg
    End If
End If
End Sub

[Crapahute]

Ok, it crashes there :

Private Sub LVLoadFolderEx(ByVal sPath As String, Optional bLoadFID As Boolean = False, Optional bFallbackPresent As Boolean = False, Optional siFallback As oleexp.IShellItem, Optional IsRefresh As Boolean = False, Optional lAssignSearchIdx As Long = -1&)

[...]

DebugAppend "LVLoadFolderEx:: Line 3"
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    hFind = FindFirstFileNt(strPath, bytBuffer)
DebugAppend "LVLoadFolderEx:: Line 4"

[...]

I get Line 3 in my log and not Line 4, so I think that it is FindFirstFileNt(strPath, bytBuffer) that makes the crash.

[fafalone]

Yeah figured it was something in there... no idea what could be crashing only on some versions.

If you're not worried about long load times for folders with thousands of items, you can leave it off like you had. Otherwise I'd need you to narrow down the exact line within FindFirstFileNt that's causing the issue, and I could provide an alternative. There's no logging in there by default since it would eliminate all the performance benefits. But just add DebugAppend "message", and will show up in the log.

One other way, if you could provide your exact Windows version number, I'll try setting up a VM with that.

[Crapahute]

Here is what crashes :

Private Function FindFirstFileNt(ByVal strDirectory As String, bytBuffer() As Byte) As Long
[...]
' THIS LINE :
RtlFreeUnicodeString strUnicode
[...]

If I quote it, all works ok, but is it secure ?

My system :
Édition Windows 11 Professionnel
Version 23H2
Installé le ?21/?03/?23
Build du système d’exploitation 22631.3155
Expérience Windows Feature Experience Pack 1000.22684.1000.0

[fafalone]

Ah yes that's the more recent one I recall! Omg, so sorry I forgot--- I had even added it to "Known Issues" 6 months ago--

[*] On certain versions of Windows 11, a crash occurs in FindFirstFileNt on the RtlFreeUnicodeString call. This call was an improper usage of the API and you can safely comment that line out.

RtlFreeUnicodeString isn't supposed to be used in this scenario--- since the string wasn't allocated by the Rtl* functions (RtlInitUnicodeString only sets the struct to an existing string) but by VB, it's resulting in either a double free, or some weird memory access issue. Which never caused a problem up until recently, but I guess some update changed that.

Yes, leave it commented out, it will be removed in the next update (it's already removed in twinBASIC versions).


Really appreciate the effort to run that down, sorry for the bug, and double sorry for forgetting I already went through this once. Though if you checked Known Issues

[Crapahute]

No problem and thank you for the great codes of yours !

(Next time I will look for known issues )