Page 1 of 2 12 LastLast
Results 1 to 40 of 66

Thread: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Name:  ucdctest.jpg
Views: 2459
Size:  41.0 KB
    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:

    Code:
    '********************************************************************
    ' 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
    Last edited by fafalone; May 19th, 2024 at 11:54 PM. Reason: New version

  2. #2
    Fanatic Member
    Join Date
    Jun 2016
    Location
    España
    Posts
    514

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    good job Fafalone.
    Work fine

  3. #3
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,230

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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>

  4. #4
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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:

    Code:
    Subclass2 hMain, AddressOf ucDriveComboWndProc, hMain, ObjPtr(Me)
    Attachment 191256
    Last edited by AAraya; Apr 22nd, 2024 at 10:38 AM.

  5. #5
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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?

    Name:  ucDriveCombo area beneath combo.png
Views: 253
Size:  2.9 KB

    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?

    Code:
        
        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.
    Last edited by AAraya; Apr 22nd, 2024 at 11:04 AM.

  6. #6
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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?

  7. #7
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    @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
    Code:
    ' 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.

  9. #9
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

    Code:
    Call UserControl.SetFocus

  10. #10
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Latest test, all works GREAT!

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

  11. #11

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Project Updated - Version 1.2

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

    Code:
    ' 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)

  12. #12

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Quote Originally Posted by AAraya View Post
    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.

  13. #13
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

  14. #14

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

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

    Code:
    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.
    Last edited by fafalone; Apr 22nd, 2024 at 04:51 PM.

  15. #15
    Member
    Join Date
    Jul 2017
    Posts
    44

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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

  16. #16

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

  17. #17

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Project Updated - Version 1.3

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

    Code:
    ' 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

  18. #18
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

    Name:  ucDriveComboInDesigner.png
Views: 208
Size:  2.5 KB
    Last edited by AAraya; Apr 23rd, 2024 at 08:57 AM.

  19. #19
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

  20. #20
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

    Name:  ucDriveComboShareName.jpg
Views: 207
Size:  16.2 KB
    Last edited by AAraya; Apr 23rd, 2024 at 09:20 AM.

  21. #21

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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:

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

  22. #22
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Quote Originally Posted by fafalone View Post
    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:

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

    Name:  ucDriveCombo name and version.jpg
Views: 209
Size:  17.9 KB
    Last edited by AAraya; Apr 23rd, 2024 at 09:33 AM.

  23. #23

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Quote Originally Posted by AAraya View Post
    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.

    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.

  24. #24

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    Quote Originally Posted by AAraya View Post
    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.

    Name:  ucDriveCombo name and version.jpg
Views: 209
Size:  17.9 KB
    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.

  25. #25
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

  26. #26
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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!

  27. #27
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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?

  28. #28

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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?

  29. #29
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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]"
    Last edited by AAraya; Apr 23rd, 2024 at 12:12 PM.

  30. #30

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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:

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

  31. #31
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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

  32. #32

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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?

  33. #33
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

    Code:
        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
    Last edited by AAraya; Apr 23rd, 2024 at 06:59 PM.

  34. #34

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

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

  35. #35
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

  36. #36
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

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

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

    Code:
      '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

  37. #37
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

    Code:
    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
    Last edited by AAraya; Apr 24th, 2024 at 10:06 AM.

  38. #38
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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.

    Code:
    If Share then
      Drive = LCase$(Drive Letter Path) &  " " & "[" & UNC Path & "]"
    End If
    That feels kludgy to me.
    Last edited by AAraya; Apr 24th, 2024 at 10:48 AM.

  39. #39
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,262

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    love it
    https://github.com/yereverluvinunclebert

    Skillset: VMS,DOS,Windows Sysadmin from 1985, fault-tolerance, VaxCluster, Alpha,Sparc. DCL,QB,VBDOS- VB6,.NET, PHP,NODE.JS, Graphic Design, Project Manager, CMS, Quad Electronics. classic cars & m'bikes. Artist in water & oils. Historian.

    By the power invested in me, all the threads I start are battle free zones - no arguing about the benefits of VB6 over .NET here please. Happiness must reign.

  40. #40
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: [VB6, twinBASIC] ucDriveCombo - A modern DriveList replacement

    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

    Code:
    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
    Name:  ucDriveComboShare working.jpg
Views: 146
Size:  17.9 KB

    Ultimately, you'll want to modify this with a W version so it can handle Unicode.
    Last edited by AAraya; Apr 24th, 2024 at 04:38 PM.

Page 1 of 2 12 LastLast

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width