[VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

[fafalone]

ucDriveCombo v1.6 - Modern DriveList Replacement
Updated 19 May 2024

While my ucShellBrowse control is capable of displaying a drive list like this, it's really overkill if that's all you need. I thought VB6 and twinBASIC could use a simple but modernized replacement of just the DriveList control. This project is supplied as a VB6 .ctl that has code which runs unmodified in twinBASIC, with 64bit support. Project files for both are provided. For VB6, you must include mUCDCHelper.bas in your projects. In twinBASIC, this module is combined in the same .twin file as the control.

**No typelib or package dependency!** Just need the .ctl/.ctx/.bas for VB6 or the .tbcontrol/.twin for twinBASIC; doesn't require oleexp, WinDevLib, or any similar dependencies.

Full readme:

'********************************************************************
' ucDriveCombo v1.6
' A Modern DriveList Replacement
' by Jon Johnson
'
' Provides a modernized option for a Drive Combo without the extra
' complexity of a full blown ucShellBrowse control.
'
' Requirements: VB6 or twinBASIC Beta 515
'    Note: This file combines the mUCDCHelper module; in VB6 that
'          must be in its own .bas.
'
' Features:
'   -Same codebase for VB6 and twinBASIC
'   -64bit compatible
'   -Filter drives shown by type
'   -Uses same friendly name and icon as Explorer
'   -Monitors for drive add/remove (optional)
'   -Supports both dropdown list and standard dropdown styles
'   -Drive selection can be get/set by path, letter, or name.
'   -SelectionChanged event
'   -Can provide list of drives
'   -Can optionally classify USB hard drives as removable.
'
' Changelog:
'  Version 1.6 (Released 19 May 2024)
'   -Added ShowHiddenDrives option, default false, to show/hide
'    drives that are hidden from the user in Explorer.
'   -Changed default BackColor to standard CB's white.
'
'  Version 1.5 (Released 27 Apr 2024)
'   -(Bug fix) NoFixedUSB option not working
'   -(Bug fix) Drive type always reported as 0
'
'  Version 1.4 (Released 25 Apr 2024)
'   -The .Drive legacy method now returns the same path for
'    mapped network drives.
'   -There's now a drive icon and control name/version in the
'    combobox during design mode instead of a generic combo.
'
'  Version 1.3 (Released 23 Apr 2024)
'   -The .Drive property now returns names identical to the legacy
'     DriveList control, and when set, behaves identical to that
'     as well, only comparing the first letter.
'   -(Bug fix) ShowRemovableDrives toggled network drives instead.
'
'  Version 1.2 (Released 22 Apr 2024)
'   -Add Drive property get/let for compatibility with DriveList;
'     it behaves identically to .SelectDriveName.
'   -DriveCount is now ListCount, for DriveList compat. Also added
'     .ListIndex for selected index, and .List, same as GetDriveName.
'   -Add Enabled property get/let.
'   -(Bug fix) FocusDriveList VB6 syntax error
'   -(Bug fix) VB6 control bottom cut off
'
'  Version 1.1 (Released 22 Apr 2024)
'   -Autosize UC height to combo height
'   -Custom drop width now DPI aware
'   -FocusDriveList method to hopefully partially defray the lack of
'      a massive and usually typelib dependent in-place activation
'      hook to handle tab properly. Recommend ucShellBrowse if you
'      need proper tab key support.
'   -(Bug fix) DPI variable overridden by old test line.
'   -(Bug fix) VB6 control bottom cut off
'
'  Version 1.0 (Released 22 Apr 2024)
'   -Add Property Lets for SelectedDrive_____
'   -Add device add/remove monitoring via RegisterDeviceNotification
'   -Add DPI aware support
'   -Add DropdownWidth option
'
'  Version Beta 1 - Initial release (Released 21 Apr 2024)
'********************************************************************

Download From GitHub

[yokesee]

good job Fafalone.
Work fine

[wqweto]

Btw, using CreateWindow created Windows control and not handling in-place activation is preventing ActiveX user-control from handling focus, tab order and keyboard navigation on form correctly.

cheers,
</wqw>

[AAraya]

Update

Ignore the problem below. User error - I had failed to copy over the BAS file into my project

Error no longer occurs. I'll do more testing now.

THANK YOU fafalone!

----

Using the CTL version just downloaded from GitHub, I get a "Compile Error: Variable Not Defined" in InitControl on this line:

Subclass2 hMain, AddressOf ucDriveComboWndProc, hMain, ObjPtr(Me)

Attachment 191256

[AAraya]

fafalone

Two questions:

1. Is there a reason for the extra space under the combo that the user control takes? Is it needed for some reason? Or can the user control be auto-sized to not be larger than required by the combo?



2. In UserControl_Initialize you calculate the DPI but then you hard code it to 1. Is that intentional or an accidental artifact from your own testing?

    
    mDPI = GetDeviceCaps(hDC, LOGPIXELSY) / 96
    ReleaseDC 0&, hDC
    mDPI = 1

I've removed the mDPI = 1 line and all works well on my 1.5 DPI system. I'll test at other DPIs in a little bit.

[AAraya]

I now see that the extra space beneath the combo can be changed via the Height property. Ideally I'd like to set Height to the exact value needed to display the combo and nothing more. How do I programmatically determine what that value is? Is that a value you can expose via the interface or maybe an AutoSize property is a better way to achieve what I'm after?

[AAraya]

Suggestion... for backward compatibility and easier/quicker drop in replacement for the existing VB6 DriveListBox, perhaps consider adding Public Property Let/Get "Drive" procedures which sets or returns the drive letter. Also, add an Enabled property. Easy enough to work around the control's new interface as it is however.

[fafalone]

@wqweto, thanks I know, ucShellBrowse/ucShellTree handle that, but the idea here was something simple, not another massive one. I recommend people use ucShellBrowse in DrivesOnly mode if they need tab focus (I'll have to test drives only mode on that though; I spent days getting it right for drives+files mode but didn't test the simpler ones). I wanted to avoid added a VB6 typelib dependency to this control or putting in hundreds of to do it within the control. I'll add a FocusDriveList method to maybe help a little.


@AAraya - (1) Not needed, I'll add code to autosize it. It wasn't done in the first place because it's a bit of a pain; the normal size stuff includes the height of the dropdown. (2) Yes sorry that's an artifact from a tB bug while developing. Note that the only time DPI awareness comes into play is if you're setting a maximum dropdown size smaller than the total item height and (in the new release, should have been from the start) setting a custom width, in an app you've marked as dpiAware via manifest or API.

Project Updated to v1.1

' Changelog:
'  Version 1.1 (Released 22 Apr 2024)
'   -Autosize UC height to combo height
'   -Custom drop width now DPI aware
'   -FocusDriveList method to hopefully partially defray the lack of
'      a massive and usually typelib dependent in-place activation
'      hook to handle tab properly. Recommend ucShellBrowse if you
'      need proper tab key support.
'   -(Bug fix) DPI variable overridden by old test line.

[AAraya]

In FocusDriveList(), I had to change the first line to the following to get around a compiler error that was happening.

Call UserControl.SetFocus

[AAraya]

Latest test, all works GREAT!

I added a Drive property for backward compat which just calls your SelectedDriveLetter method.

[fafalone]

Project Updated - Version 1.2

I saw AAraya's feature requests just right after I posted the first update LOL.

' Changelog:
'  Version 1.2 (Released 22 Apr 2024)
'   -Add Drive property get/let for compatibility with DriveList;
'     it behaves identically to .SelectDriveName.
'   -DriveCount is now ListCount, for DriveList compat. Also added
'     .ListIndex for selected index, and .List, same as GetDriveName.
'   -Add Enabled property get/let.
'   -(Bug fix) FocusDriveList VB6 syntax error
'   -(Bug fix) VB6 control bottom cut off

Download from GitHub

(All project files and builds updated)

[fafalone]

Latest test, all works GREAT!

I added a Drive property for backward compat which just calls your SelectedDriveLetter method.

I checked the original VB6 control and the Drive() method returns the friendly name, like

e: [WD_4TB]
g: [SG_4TB]

*Except* for C: for some reason. I don't know if that's just my computer or some glitch on my version of Windows... I know where the glitch comes from though; it's using GetVolumeInformation for the label, which for some reason, if C:\ has the default 'Local disk' label, returns a blank. This is why I switched to using SHParseDisplayName/SHGetNameFromIDList. I'll see how widespread the issue is across Windows versions and if it impacts it if you change the label to something else, but for now, .Drive is using the 'Name' property, equivalent to SelectedDriveName.

[AAraya]

I checked the original VB6 control and the Drive() method returns the friendly name, like

Interesting my Drive property implementation which called SelectedDriveLetter() worked great as a replacement for my existing VB DriveList. I'll give your version a test. Thanks for also making those other backward compat changes as well. I'll do more testing tomorrow morning and provide feedback.

[fafalone]

They all provide the same information, just slightly different.

SelectedDriveLetter = "C"
SelectedDrivePath = "C:"
SelectedDriveName = "Local disk (C:\)"

With the old control, it gave the label slightly different, like "c: [Local disk]"; so likely anyone using it is just taking the first char, which would make SelectedDriveLetter a good replacement, and Name wouldn't work. I think for the next update (give me a day or two), I'll have .Drive mimic the old control exactly.

Edit: Also fixing the .Drive = behavior; I had it matching the whole string, the old behavior is apparently just matching the first letter. Drive1.Drive = "Dfihskjaks" will change it to D:\

I'll update the control tonight or tomorrow, but if you want to play around with it before that, here's the function I made that duplicates the old name (I'm adding NameOld to the DriveEntry UDT and calling it from RefreshDriveList where it sets the rest of the info):

    Private Declare PtrSafe Function GetVolumeInformationW Lib "kernel32" (ByVal lpRootPathName As LongPtr, ByVal lpVolumeNameBuffer As LongPtr, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As LongPtr, ByVal nFileSystemNameSize As Long) As BOOL

    Private Declare Function GetVolumeInformationW Lib "kernel32" (ByVal lpRootPathName As LongPtr, ByVal lpVolumeNameBuffer As LongPtr, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As LongPtr, ByVal nFileSystemNameSize As Long) As BOOL

Private Sub SetOldName(sPath As String, sLetter As String, nIdx As Long)
    Dim sTmp As String
    Dim sOld As String
    Dim dwFlag As Long
    sOld = LCase$(sLetter) & ":"
    sTmp = String$(34, 0)
    If GetVolumeInformationW(StrPtr(sPath), StrPtr(sTmp), 34, ByVal 0, 0, dwFlag, 0, 0) Then
        If InStr(sTmp, vbNullChar) > 1 Then
            sTmp = Left$(sTmp, InStr(sTmp, vbNullChar) - 1)
            sOld = sOld & " [" & sTmp & "]"
        End If
    End If
    mDrives(nIdx).NameOld = sOld
End Sub

The path and letter formats are as used elsewhere; C:\ and C, respectively. It duplicates VB perfectly; VB doesn't get the label of my USB thumbdrive, neither does this, so both just return r:

And the properly behaved property:

Public Property Get Drive() As String
    If Ambient.UserMode Then
        Dim nIdx As Long
        Dim nSel As Long
        nSel = CLng(SendMessage(hMain, CB_GETCURSEL, 0, ByVal 0))
        nIdx = -1
        nIdx = CLng(GetCBXItemlParam(hMain, nSel))
        Drive = mDrives(nIdx).NameOld
    End If
End Property
Attribute Drive.VB_MemberFlags = "400"
Public Property Let Drive(ByVal sName As String)
    If Ambient.UserMode Then
        If mCt Then
            Dim i As Long
            For i = 0 To UBound(mDrives)
                If LCase$(mDrives(i).Letter) = LCase$(Left$(sName, 1)) Then
                    SendMessage hMain, CB_SETCURSEL, mDrives(i).Index, ByVal 0
                    RaiseEvent SelectionChanged(mDrives(i).Path, mDrives(i).Letter, mDrives(i).Name, mDrives(i).Type)
                    Exit Property
                End If
            Next
            Err.Raise 68
        End If
    End If
End Property

Note: Careful pasting that into VB because "Attribute Drive.VB_MemberFlags = "400"" is hidden by the IDE, so you'll delete it if copy/paste the full thing. Just copy the property get/let contents separately, just the code not the declare.

It raises the same 'error 68 device not found' error as the old control there, but I haven't tested if that behaves the exact same way. I also need to check whether it raises a changed event if given the same letter as currently selected.

[bahbahbah]

Nice work, fafalone.


If run from VB6 IDE, it doesn't show the network drives. Compiled or TB they show fine (ShowNetworkDrives = True in both, run in admin mode too).

If "ShowNetworkDrives" is toggled, it also toggles "ShowRemovableDrives" - not sure if that's intentional.

If "ShowRemovableDrives" is set to false, my USB/flash drives still show up.

In VB6, whether compiled or in IDE, about 80% of the time if I try to close the dropdown by clicking on the blank space to the left of the arrow, it closes and then opens again. Doesn't seem to happen with the TB one.

Cheers

[fafalone]

If run from VB6 IDE, it doesn't show the network drives. Compiled or TB they show fine (ShowNetworkDrives = True in both, run in admin mode too).

Network drives have to either be re-mapped in admin mode or a registry setting toggled; but there shouldn't be a difference between VB6 and tB here... it's the same code calling the same API; it's nothing fancy, just GetLogicalDriveStringsW. You're sure tB was running as admin too? (In the top right corner of the IDE, it will have 'ADMIN' in orange letters).

If "ShowRemovableDrives" is set to false, my USB/flash drives still show up.

This is caused by the mixup from the issue before that, I'll post a bug fix in a bit. Sorry about that. ShowRemovableDrives is actually toggling the variable control network drives. Note that Windows counts USB hard drives as fixed disks; if you want them counted as removable like flash drives, that's what the NoFixedUSB option is for.

In VB6, whether compiled or in IDE, about 80% of the time if I try to close the dropdown by clicking on the blank space to the left of the arrow, it closes and then opens again. Doesn't seem to happen with the TB one.

This seems to be a bug with the underlying ComboBoxEx control itself; it's happening when comctl6 isn't enabled. tB enables those by default (the 'Visual Styles' checkbox when creating/importing), where VB6 doesn't; I didn't include a manifest with VB6 version. Since the old controls don't properly support DropDownList anyway, I recommend just setting ComboStyle to the other option if you don't want to add a common controls manifest to VB6 apps (and the IDE to enable them there).

[fafalone]

Project Updated - Version 1.3

Fixes the Removable drive/network drive mixup bug, applies post #14 changes.

' Changelog:
'  Version 1.3 (Released 23 Apr 2024)
'   -The .Drive property now returns names identical to the legacy
'     DriveList control, and when set, behaves identical to that
'     as well, only comparing the first letter.
'   -(Bug fix) ShowRemovableDrives toggled network drives instead.

Download from GitHub

[AAraya]

Nice to have suggestion...

When placed on a form, the combo looks like any other combo and doesn't visually let you know that it's a drive combo. Compare this to the VB6 DriveListBox which displays the C drive when drawn on a form.

[AAraya]

Backward compat Event name change suggestion...

Consider renaming the "SelectionChanged" event to simply "Change" to match VB6's control.

Again, just to make upgrading from VB6 to the new control as quick and easy as possible with all existing code just working out of the box.

[AAraya]

Properties "missing" from the interface:
Font
ForeColor

Issues found:

- Changing Backcolor property on Property Page does not immediately show new color on control on Form when in design mode. After I execute the code, the new backcolor is then shown in the designer properly.
- Selecting the same Drive fires the SelectionChanged event. VB6's control does not fire Change event when same drive is selected
- Share name format differs from VB6 in both the combo and the value return in the Drive property.

[fafalone]

Sure I can add that. I'm not going to update the control yet just for that so if you want to add it yourself, all you need to do is go to the InitControl sub, and add an Else condition to the If Ambient.UserMode Then block:

    Else
        Dim sSys As String
        Dim l As Long
        sSys = String$(MAX_PATH, 0)
        l = GetWindowsDirectoryW(StrPtr(sSys), MAX_PATH)
        If l Then
            sSys = Left$(sSys, IIf(l < 3, l, 3))
        Else
            sSys = Left$(Environ("WINDIR"), 3)
        End If
        Dim nIcon As Long
        nIcon = GetIconIndex(sSys, SHGFI_SMALLICON)
        CBX_InsertItem(hMain, Me.Name & " Version " & App.Major & "." & App.Minor, nIcon)
        SendMessage hMain, CB_SETCURSEL, 0, ByVal 0

[AAraya]

Sure I can add that. I'm not going to update the control yet just for that so if you want to add it yourself, all you need to do is go to the InitControl sub, and add an Else condition to the If Ambient.UserMode Then block:

    Else
        Dim sSys As String
        Dim l As Long
        sSys = String$(MAX_PATH, 0)
        l = GetWindowsDirectoryW(StrPtr(sSys), MAX_PATH)
        If l Then
            sSys = Left$(sSys, IIf(l < 3, l, 3))
        Else
            sSys = Left$(Environ("WINDIR"), 3)
        End If
        Dim nIcon As Long
        nIcon = GetIconIndex(sSys, SHGFI_SMALLICON)
        CBX_InsertItem(hMain, Me.Name & " Version " & App.Major & "." & App.Minor, nIcon)
        SendMessage hMain, CB_SETCURSEL, 0, ByVal 0

Done!

I had to make two changes:
1. Add a "Call" statement before CBX_InsertItem
2. Change Me.Name to UserControl.Name

When I make those changes it runs without error.

What displays is now the user control name and a version number (it's showing the version number of my app, not the user control!), and no icon. That's helpful but not quite the same as VB6. But it definitely works for self-identifying.

[fafalone]

Backward compat Event name change suggestion...

Consider renaming the "SelectionChanged" event to simply "Change" to match VB6's control.

Again, just to make upgrading from VB6 to the new control as quick and easy as possible with all existing code just working out of the box.

DriveList_Change doesn't provide any information so I'll add an identical version, and preserve SelectionChanged for new code.

Properties "missing" from the interface:
Font
ForeColor

Issues found:
Changing Backcolor property on Property Page does not immediately show new color on control on Form when in design mode.

I can add font but I'm not sure how practical a ForeColor method is, I'll see how the control behaves.

BackColor shouldn't be visible at all now that the UserControl size is limited to the combo size. I'll add a refresh though.

[fafalone]

Done!

I had to make two changes:
1. Add a "Call" statement before CBX_InsertItem
2. Change Me.Name to UserControl.Name

When I make those changes it runs without error.

What displays is now the user control name and a version number (it's showing the version number of my app, not the user control!), and no icon. That's helpful but not quite the same as VB6. But it definitely works for self-identifying.

Sorry it's preliminary so I hadn't tested in VB too yet, just tB, which allows ( ) and Me.Name works. But the VB6 changes you used work in both so that will be the final one used.

I thought the type of control was more relevant than "c:"... you can use that if you really want to. And yeah hadn't thought about the version, I'll just remove that and leave the name.

For the icon, I forgot to add you need to move the line Call SendMessage(hMain, CBEM_SETIMAGELIST, 0, ByVal himl) up above If Ambient.UserMode Then so it fires for both.

[AAraya]

Apparently there are two BackColors at play here. 1. The UserControl backcolor and 2. The ComboBox backcolor.

Now that you've implemented AutoSize, the UserControl backcolor does not matter any longer. But the user still needs the ability to change the backcolor of the combo itself. Your code is currently doing this properly but not until after its executed. I tried adding a UserControl.Refresh to the BackColor property Let but it didn't resolve the issue..

[AAraya]

For the icon, I forgot to add you need to move the line Call SendMessage(hMain, CBEM_SETIMAGELIST, 0, ByVal himl) up above If Ambient.UserMode Then so it fires for both.

Done and works!

[AAraya]

By the way - even though the Share name format displayed in the ucDriveCombo differs from the VB6 control, the format you have conforms to what Windows 10 File Explorer uses so I think it's good to keep that as you have it now. But what about the format returned by the Drive property for the share? Should that conform to VB6's version?

[fafalone]

I don't have any shared drives hooked up right now... the format for those is different? Just to double check, you have Version 1.3 from last night that modified .Drive to return the old format for (what I thought would be all) drives?

If so, what format are they in?

[AAraya]

Yes, the format for Shares is different. Both in the combo edit portion and in the value returned by the Drive property. (I'm running the latest version of the user control - v1.3)

I'm of the opinion that what you're displaying in the combo edit portion is good, even though it's different than VB6, as it conforms to what is displayed by Windows 10 File Explorer. I wouldn't worry the differing formats for backward compat as it's a display-only value.

The value returned by the Drive property is the one that maybe should be considered. As this is the return value that users are going to be working with, I think it should probably be in the same format as the VB6 control it replaces.

Here's what each of the controls return when I select my L drive:

VB6DriveListBox.Drive = "l: [\\LS210D8A8\Share]"
ucDriveCombo.Drive = "l: [share]"

[fafalone]

Interesting... I figured VB6 was just doing a simple GetVolumeInformation call, because it was missing the label in all the same circumsances... you actually have to do a little work to get the network path like that; not sure why VB would do it separately. Maybe there's a 3rd way that does that too?

Anyway could you see if this returns the share path:

    Private Type UNIVERSAL_NAME_INFOW
        lpUniversalName As LongPtr
    End Type
    Private Enum NETWK_NAME_INFOLEVEL
        UNIVERSAL_NAME_INFO_LEVEL = &H00000001
        REMOTE_NAME_INFO_LEVEL = &H00000002
    End Enum
    Private Declare PtrSafe Function WNetGetUniversalNameW Lib "mpr.dll" (ByVal lpLocalPath As LongPtr, ByVal dwInfoLevel As NETWK_NAME_INFOLEVEL, lpBuffer As Any, lpBufferSize As Long) As Long
    Private Declare PtrSafe Function lstrlenW Lib "kernel32" (lpString As Any) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)


Private Sub checkname()
    Dim tn As UNIVERSAL_NAME_INFOW
    Dim lRet As Long
    lRet = WNetGetUniversalNameW(StrPtr("L:\"), UNIVERSAL_NAME_INFO_LEVEL, tn, LenB(tn))
    If lRet = 0 Then
        Dim sPath As String
        sPath = LPWSTRtoStr(tn.lpUniversalName)
        Debug.Print sPath
    End If
End Sub
Private Function PointerToStringW(ByVal lpStringW As Long, Optional Length As Long = -1) As String
Dim Buffer() As Byte
If lpStringW Then
   If Length < 0 Then Length = lstrlenW(lpStringW) * 2
   If Length Then
      ReDim Buffer(0 To (Length - 1)) As Byte
      CopyMemory Buffer(0), ByVal lpStringW, Length
      PointerToStringW = Buffer
   End If
End If
End Function

LPWStrToStr is already in the project; if that crashes in the above, switch to the alternate PointerToStringW; I don't know how it allocates the string and don't have a network drive handy to check.

[AAraya]

Sure, I'd be happy to check that for you. Where do I put that code - in the UC or in any sub/form?

Initially I put it into an empty form but all the PtrSafe lines turned red. VB6 doesn't seem to like those declarations

[fafalone]

Just remove 'PtrSafe' in VB6; that's the only difference here.

You'd put it somewhere in the UserControl and call it... maybe make checkname Public and call it from a button click on Form1?

[AAraya]

The call to WNetGetUniversalNameW returns a value of 234 so the code in the IF block is never executed.

    If lRet = 0 Then
        Dim sPath As String
        sPath = LPWSTRtoStr(tn.lpUniversalName)
        Debug.Print sPath
    End If

I tried to debug it but couldn't get it to work. Have you considered the WNetGetConnection() API? Seems like it might return what you're looking for.

http://vbnet.mvps.org/index.html?cod...appeddrive.htm

[fafalone]

The difference between the two was supposed to be that WNetGetConnection required the drive to be actively connected, but sure if you want to switch that in and let me know if it works?

Error 234 is ERROR_MORE_DATA so it must behave contrary to documentation and append the data pointed to into the return...

Dim bt() As Byte
ReDim bt((MAX_PATH * 2 + 1) + LenB(tn))
lRet = WNetGetUniversalNameW(StrPtr("L:\"), UNIVERSAL_NAME_INFO_LEVEL, bt(0), UBound(bt) + 1)
If lRet = 0 Then
    CopyMemory tn, bt(0), LenB(tn)
    Dim sPath As String
    sPath = PointerToStringW(tn.lpUniversalName)
    Debug.Print sPath
End If

[AAraya]

Dim bt() As Byte
ReDim bt((MAX_PATH * 2 + 1) + LenB(tn))
lRet = WNetGetUniversalNameW(StrPtr("L:\"), UNIVERSAL_NAME_INFO_LEVEL, bt(0), UBound(bt) + 1)
If lRet = 0 Then
    CopyMemory tn, bt(0), LenB(tn)
    Dim sPath As String
    sPath = PointerToStringW(tn.lpUniversalName)
    Debug.Print sPath
End If

The latest version of checkname ran but sPath appears to be a truncated version of the share's UNC path.

The Immediate window showed "\\LS21" rather than "\\LS210D8A8\Share".

I spent a good while trying to debug why it was being truncated, I looked at the MS documentation for the function, checked PointerToStringW, examined the contents of the byte array, and borrowed ideas from Dilettante's implementation. But still get a truncated version of the full UNC path.

I'll play with WNetGetConnection now and see if I get better results.

[AAraya]

WNetGetConnection works! It correctly returns the UNC path name for the drive letter - "\\LS210D8A8\Share"

The Drive Letter passed to it needs to be Drive letter + Colon (e.g. "L:"). Any other format fails (e.g. "L" or "L:" both fail).

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Public Sub checkname()
    Const NO_ERROR As Long = 0

    Dim strDriveLetter  As String
    Dim sPath           As String
    Dim sRemoteName     As String
    Dim lngRet          As Long
    Dim cbRemoteName    As Long
    
    sRemoteName = SPACE$(MAX_PATH)
    cbRemoteName = Len(sRemoteName)
    
    strDriveLetter = "L:"
    
    lngRet = WNetGetConnection(strDriveLetter, sRemoteName, cbRemoteName)
    If lngRet = NO_ERROR Then
       sPath = TrimNull(sRemoteName)
       Debug.Print sPath
    End If
    
End Sub

This is just a proof of concept. You'd probably want to use the W version of this and also do some pre and post checks like the MVPS site does:

  'if drive letter is a network share, 
  'resolve the share UNC name 
   If IsPathNetPath(sLocalRoot) Then
      If WNetGetConnection(sLocalRoot, _
                           sRemoteName, _
                           cbRemoteName) = ERROR_SUCCESS Then
         
        'this assures the retrieved name is in
        'fact a valid UNC path. 
         If IsUNCPathValid(sRemoteName) Then
            GetUncFromMappedDrive = TrimNull(sRemoteName)
         End If
         
      End If
   End If

[AAraya]

Interestingly enough, the ANSI version of WNetGetUniversalName also works properly. So the problem seems to be with our VB6 implementation of WNetGetUniversalNameW or a problem with the function itself?

Here's some sloppy code I just threw together as a test which I got from this site.

Private Const UNIVERSAL_NAME_BUFFER_SIZE = 1000

Private Type UNIVERSAL_NAME_INFO
    lpUniversalName                         As Long
    buf(UNIVERSAL_NAME_BUFFER_SIZE - 4)     As Byte
End Type

Public Sub checkname()
    Dim BufSize         As Long
    Dim StartLoc        As Long
    Dim strDriveLetter  As String
    Dim sPath           As String
    Dim uni             As UNIVERSAL_NAME_INFO
    
    Const NO_ERROR As Long = 0
    
    strDriveLetter = "L:\"
    BufSize = UNIVERSAL_NAME_BUFFER_SIZE
    If WNetGetUniversalNameA(strDriveLetter, UNIVERSAL_NAME_INFO_LEVEL, uni, BufSize) = NO_ERROR Then
        'After we return from WNetGetUniversalName, the lpUniversalName contains a pointer for the
    'universal path name.
        'The pointer is usually points to the first byte of the buffer array
    '(buf variable in UNIVERSAL_NAME_INFO ).
        
    'Just to be safe, I calculate the exact location of the string in the buffer,
    'by the following expression: (The result is always 1)
        StartLoc = uni.lpUniversalName - VarPtr(uni) - 3
        sPath = Mid$(StrConv(uni.buf, vbUnicode), StartLoc)
        Debug.Print sPath
    Else
        MsgBox "Error: cannot find the universal path of " & strDriveLetter, vbOKOnly Or vbExclamation, ""
    End If
End Sub

[AAraya]

So it seems that for shares you just need to concatenate the drive letter path with the UNC path like so to replicate what VBs DriveListBox control is returning for the Drive property value.

If Share then
  Drive = LCase$(Drive Letter Path) &  " " & "[" & UNC Path & "]"
End If

That feels kludgy to me.

[yereverluvinuncleber]

love it

[AAraya]

fafalone - I've got the ucDriveCombo.Drive value returning the same value as VBs DriveListBox. I changed the SetOldName proc to handle shares as a special case and I'm using the ANSI version of WNetGetUniversalName.

Feel free to cleanup the code, as it's not elegant but functional

Private Const UNIVERSAL_NAME_BUFFER_SIZE as Long = 1000
Private Const BOOL_TRUE As Long = 1
Private Const NO_ERROR  As Long = 0

Private Type UNIVERSAL_NAME_INFO
    lpUniversalName                         As Long
    Buf(UNIVERSAL_NAME_BUFFER_SIZE - 4)     As Byte
End Type
Private Declare Function WNetGetUniversalNameA Lib "mpr.dll" (ByVal lpLocalPath As String, ByVal dwInfoLevel As Long, lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathW" (ByVal lpszPath As Long) As Boolean
Private Declare Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCW" (ByVal lpszPath As Long) As Boolean
Private Declare Function PathRemoveBackslash Lib "shlwapi" Alias "PathRemoveBackslashW" (ByVal lpszPath As Long) As Long

Private Sub SetOldName(sPath As String, sLetter As String, nIdx As Long)
    Dim sOld As String
    
    ' Handle network paths
    If IsNetworkPath(sPath) Then
        sOld = GetNetworkPath(sPath)
    Else
        ' Handle other non-share drives
        sOld = GetNonNetworkPath(sPath, sLetter)
    End If
    
    ' Store the old name in the appropriate array element
    mDrives(nIdx).NameOld = sOld
End Sub

Private Function IsNetworkPath(sPath As String) As Boolean
    ' Check if the path is a network path
    IsNetworkPath = (PathIsNetworkPath(StrPtr(sPath)) = BOOL_TRUE)
End Function

Private Function GetNetworkPath(sPath As String) As String
    Dim strDrivePath As String
    Dim uni As UNIVERSAL_NAME_INFO
    Dim strUNCPath As String
    
    strDrivePath = sPath
    
    ' Get the universal name for the network path
    If WNetGetUniversalNameA(strDrivePath, UNIVERSAL_NAME_INFO_LEVEL, uni, UNIVERSAL_NAME_BUFFER_SIZE) = NO_ERROR Then
        strUNCPath = TrimNull(Mid$(StrConv(uni.Buf, vbUnicode), uni.lpUniversalName - VarPtr(uni) - 3))
        Call PathRemoveBackslash(StrPtr(strUNCPath))
        strUNCPath = TrimNull(strUNCPath)    'remove null added by PathRemoveBackslash
        If PathIsUNC(StrPtr(strUNCPath)) = 1 Then
            ' Construct the share name
            GetNetworkPath = LCase$(strDrivePath) & " [" & strUNCPath & "]"
        End If
    End If
End Function

Private Function GetNonNetworkPath(sPath As String, sLetter As String) As String
    Dim sTmp As String
    Dim dwFlag As Long
    
    ' Get the drive name and volume information for non-network paths
    GetNonNetworkPath = LCase$(sLetter) & ":"
    sTmp = String$(34, 0)
    If GetVolumeInformationW(StrPtr(sPath), StrPtr(sTmp), 34, ByVal 0, 0, dwFlag, 0, 0) Then
        If InStr(sTmp, vbNullChar) > 1 Then
            sTmp = Left$(sTmp, InStr(sTmp, vbNullChar) - 1)
            GetNonNetworkPath = GetNonNetworkPath & " [" & sTmp & "]"
        End If
    End If
End Function

Ultimately, you'll want to modify this with a W version so it can handle Unicode.