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

Code:

---

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...

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.

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 :

Code:

---

Private Const mDefHighPerfMode As Boolean = True

---

in

Code:

---

Private mDefHighPerfMode As Boolean

---

and add in UserControl_Initialize

Code:

---

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 :

Code:

---

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

Code:

---

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.

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

Code:

---

        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.

Hi Crapahute

mDefHighPerfMode = False seems to be THE SOLUTION !

Thank you

Quote:

---

Originally Posted by fafalone

Code:

---

        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.

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

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

Code:

---

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

---

Ok, it crashes there :

Code:

---

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.

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.

Here is what crashes :

Code:

---

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

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--

Quote:

---

[*] 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 :p

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

(Next time I will look for known issues :p)

Hi All.
I'm having a problem trying to perform a drag drop operation.
I have some controls on one form, and ucshellbrowse on another. When I try to perform a file drag drop (in manual mode) it doesn't work at all. When I set it to automatic mode it works without any problems, but the control doesn't let me do anything other than drag. It completely disables file selection and folder switching, etc. Could anyone who has also experienced this problem please tell me how to fix it? Thanks.

The VB drag options shouldn't be touched; the control drag options are set only through FileDragDropMode. The "DragMode" property for the UC on the Form should be manual, and the "OLEDropMode" in the UC design editor should be none.

If both of those are set right, and FileDragDropMode is 0 - SBDD_DragDrop; could you please clarify what 'doesn't work at all' means--- the drag operation doesn't start? Or the drop target doesn't accept it? If it's the 2nd; does Explorer accept it, and does your drop target accept files from Explorer?

Quote:

---

Originally Posted by fafalone

The VB drag options shouldn't be touched; the control drag options are set only through FileDragDropMode. The "DragMode" property for the UC on the Form should be manual, and the "OLEDropMode" in the UC design editor should be none.

If both of those are set right, and FileDragDropMode is 0 - SBDD_DragDrop; could you please clarify what 'doesn't work at all' means--- the drag operation doesn't start? Or the drop target doesn't accept it? If it's the 2nd; does Explorer accept it, and does your drop target accept files from Explorer?

---

Hello, thanks for responding.
I'll review what you're telling me, as I may be doing something wrong and not have realized it.
I'll let you know as soon as I can.

Quote:

---

The VB drag options shouldn't be touched; the control drag options are set only through FileDragDropMode. The "DragMode" property for the UC on the Form should be manual, and the "OLEDropMode" in the UC design editor should be none.

If both of those are set right, and FileDragDropMode is 0 - SBDD_DragDrop; could you please clarify what 'doesn't work at all' means--- the drag operation doesn't start? Or the drop target doesn't accept it? If it's the 2nd; does Explorer accept it, and does your drop target accept files from Explorer?

---

I've tried what you mentioned, but I can't get it to work. I'm attaching a sample project so you can please review it and let me know if I'm doing something wrong or why I can't drag and drop using ucshell.

Im using the OCX version of UcShellBrowse and UcShellTree v12.2.2.9 (x86/x64)

Ok so it's a little confusing but there's two kinds of drag drop in VB6. One is VB6's internal drag drop for controls and other VB6-internal things. The other is OLE Drag Drop, the kind that is compatible with what the rest of the system outside of VB6 uses. If you attempt to drop a file from Explorer on your Form1 controls, you'll notice it doesn't work either. Dragging a file from ucShellBrowse or ucShellTree is the same kind of OLE Drag Drop operation Explorer initiates. This is done automatically; you don't need to initiate it yourself.

On Form2, remove the ucBW.Drag statement; it doesn't support internal VB6 non-OLE drag drop and that is what that method refers to.

On Form1, change command button c1's OLEDropMode to 1- Manual.

Use OLEDragOver instead of DragOver:

Code:

---

Private Sub c1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
Dim i As Long
Dim s As String
If Data.Files.Count Then
    For i = 1 To Data.Files.Count
        s = s & Data.Files(i) & ", "
    Next
    Label2.Caption = "DRAGGING: " & s
    c1.Caption = "DRAGGING: " & s
End If
End Sub

---

You'll now see the names of the file(s) being dragged from ucShellBrowse, as well as any files dragged from Explorer or other apps (and can drag from ucShellBrowse onto them too).

Attached is a version of your project with these modifications.

Quote:

---

Originally Posted by fafalone

Ok so it's a little confusing but there's two kinds of drag drop in VB6. One is VB6's internal drag drop for controls and other VB6-internal things. The other is OLE Drag Drop, the kind that is compatible with what the rest of the system outside of VB6 uses. If you attempt to drop a file from Explorer on your Form1 controls, you'll notice it doesn't work either. Dragging a file from ucShellBrowse or ucShellTree is the same kind of OLE Drag Drop operation Explorer initiates. This is done automatically; you don't need to initiate it yourself.

On Form2, remove the ucBW.Drag statement; it doesn't support internal VB6 non-OLE drag drop and that is what that method refers to.

On Form1, change command button c1's OLEDropMode to 1- Manual.

Use OLEDragOver instead of DragOver:

Code:

---

Private Sub c1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
Dim i As Long
Dim s As String
If Data.Files.Count Then
    For i = 1 To Data.Files.Count
        s = s & Data.Files(i) & ", "
    Next
    Label2.Caption = "DRAGGING: " & s
    c1.Caption = "DRAGGING: " & s
End If
End Sub

---

You'll now see the names of the file(s) being dragged from ucShellBrowse, as well as any files dragged from Explorer or other apps (and can drag from ucShellBrowse onto them too).

Attached is a version of your project with these modifications.

---

You're absolutely right! It does work with the VB6 command button.
The problem I'm noticing now is that I'm using Noel Dacara's DCButton ActiveX control in my proyect, and it doesn't support OLE DragDrop. Only VB6's internal drag drop.
I'll try modifying the ActiveX code to add OLE. If it doesn't work, could you help me modify it and make it work?

Attached is a version of Noel Dacara's DCButton ActiveX control

Thanks!.

For basics you shouldn't have to do any more than with a regular command button; set OLEDropMode to manual and handle the oledragover and oledragdrop events. It doesn't appear that control creates its own windows that would interfere.

Obviously if you want more advanced features like showing drag images like Explorer and ucShellBrowse do it's more involved, but I don't see any reason the same basic VB6 OLEDragDrop wouldn't work.