Page 2 of 2 FirstFirst 12
Results 41 to 66 of 66

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

  1. #41

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    Project Updated - Version 1.4

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

    Download from GitHub





    I went with just Ambient.DisplayName for the IDE (with icon); so it will say e.g. "ucDriveCombo1"

    So for network paths, I stuck pretty closely to the proposed version earlier for WNetGetUniversalNameW; I don't know why it wasn't working. I put a mapped drive on a VM, and confirmed it's working now.

    Here's what I wound up doing:

    Code:
    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) & ":"
        If PathIsNetworkPathW(StrPtr(sPath)) Then
            sOld = GetOldNetName(sOld)
        Else
            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
        End If
        mDrives(nIdx).NameOld = sOld
    End Sub
    Private Function GetOldNetName(ByVal sLetter As String) As String
        Dim tn As UNIVERSAL_NAME_INFOW
        Dim lRet As Long
        Dim bt() As Byte
        Dim cb As Long
        ReDim bt((MAX_PATH * 2 + 1) + LenB(tn))
        cb = UBound(bt) + 1
        lRet = WNetGetUniversalNameW(StrPtr(sLetter), UNIVERSAL_NAME_INFO_LEVEL, bt(0), cb)
        If lRet = S_OK Then
            CopyMemory tn, bt(0), LenB(tn)
            Dim sPath As String
            Dim cch As Long
            cch = lstrlenW(ByVal tn.lpUniversalName)
            If cch = 0 Then
                GetOldNetName = sLetter
                Exit Function
            End If
            sPath = String$(cch, 0)
            CopyMemory ByVal StrPtr(sPath), ByVal tn.lpUniversalName, cch * 2
            GetOldNetName = sLetter & " [" & sPath & "]"
            Exit Function
        Else
            Debug.Print "GetOldNetName->Error: " & lRet
        End If
        GetOldNetName = sLetter
    End Function
    If something isn't right let me know.

  2. #42
    Lively Member
    Join Date
    Feb 2006
    Posts
    107

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

    I want to convert mDrives(mCt).nIcon to StdPicture in RefreshDriveList sub using OleCreatePictureIndirect.
    Code:
    Private Declare Function OleCreatePictureIndirect Lib "OLEPRO32.DLL" (lpPictDesc As PICTDESC, riid As Any, ByVal fPictureOwnsHandle As Long, ppRet As IPicture) As Long
    Private Type PICTDESC
        Size                As Long
        Type                As Long
        hBmpOrIcon          As Long
        hPal                As Long
    End Type
    ...
    Public Sub RefreshDriveList()
    	Dim diskIcon As StdPicture
    	Dim dPict As PICTDESC
    	dPict.Size = Len(dPict)
    	dPict.Type = vbPicTypeIcon
    	
    	...
    		mDrives(mCt).Name = sName
    		mDrives(mCt).nIcon = GetIconIndex(sDrives(i), SHGFI_SMALLICON)
    		
                  diskIcon = 
    		
    	...
    End sub
    ...can someone help me?

  3. #43
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,628

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

    It looks like you get a handle to the icon in the "sfi.hIcon" structure from that "GetIconIndex" function. Put that into the PICTDESC structure and you should be good to go.

  4. #44

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    You also have to add the SHGFI_ICON flag for .hIcon to be set.

  5. #45
    Lively Member
    Join Date
    Feb 2006
    Posts
    107

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

    Quote Originally Posted by VanGoghGaming View Post
    Put that into the PICTDESC
    Quote Originally Posted by fafalone View Post
    You also have to add the SHGFI_ICON flag for .hIcon to be set.
    i try ..


    Code:
    Public Sub RefreshDriveList()
            IID_IPicture = &H7BF80980
    
    	Dim diskIcon As StdPicture
    	Dim dPict As PICTDESC
    	dPict.Size = Len(dPict)
    	dPict.Type = vbPicTypeIcon
    	
    	...
    		mDrives(mCt).Name = sName
    		mDrives(mCt).nIcon = GetIconIndex(sDrives(i), SHGFI_SMALLICON)
    		
                  dPict .hBmpOrIcon = mDrives(mCt).nIcon
                  Call OleCreatePictureIndirect(dPict, IID_IPicture  , True, diskIcon)
                  
                 Picture1.Picture = diskIcon
    	...
    End sub
    ... but not work
    Last edited by cliv; Apr 25th, 2024 at 05:42 AM.

  6. #46
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,628

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

    There is a pointer to IUnknown IID:

    Code:
    Private Type tIID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
    
    Private Const IID_IUnknown As String = "{00000000-0000-0000-C000-000000000046}"
    Private Declare Function IIDFromString Lib "ole32" (ByVal lpString As Long, rIID As Any) As Long
    
    Dim tIID As tIID
    
    IIDFromString StrPtr(IID_IUnknown), tIID ' Put this tIID in the call to OleCreatePictureIndirect

  7. #47
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,628

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

    IID_IPicture also works only you've got it wrong, it's not a Long constant as you defined it, it's a pointer to a 16-bytes structure like in the example above.

    Quote Originally Posted by cliv View Post
    i try ..

    Code:
                  dPict .hBmpOrIcon = mDrives(mCt).nIcon
    ... but not work
    This is also wrong, you need the hIcon not the nIcon, both reported by the "SHGetFileInfoW" function in the "sfi" structure. I'm sure Fafalone will provide the complete code if you don't manage by then.

  8. #48
    Lively Member
    Join Date
    Feb 2006
    Posts
    107

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

    Code:
    ...
    GetIconIndex = sfi.hIcon
    ...
    I can't make it work...
    Last edited by cliv; Apr 25th, 2024 at 06:20 AM.

  9. #49
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,628

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

    Yes, like that, but only if you got the correct hIcon into "dPict"!

  10. #50
    Lively Member
    Join Date
    Feb 2006
    Posts
    107

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

    Quote Originally Posted by VanGoghGaming View Post
    Yes, like that, but only if you got the correct hIcon into "dPict"!
    thanks! work i fogot to change SHGFI_SMALLICON into SHGFI_ICON

  11. #51
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    544

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

    Quote Originally Posted by fafalone View Post
    Project Updated - Version 1.4

    So for network paths, I stuck pretty closely to the proposed version earlier for WNetGetUniversalNameW; I don't know why it wasn't working. I put a mapped drive on a VM, and confirmed it's working now.

    Here's what I wound up doing:

    Code:
    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) & ":"
        If PathIsNetworkPathW(StrPtr(sPath)) Then
            sOld = GetOldNetName(sOld)
        Else
            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
        End If
        mDrives(nIdx).NameOld = sOld
    End Sub
    Private Function GetOldNetName(ByVal sLetter As String) As String
        Dim tn As UNIVERSAL_NAME_INFOW
        Dim lRet As Long
        Dim bt() As Byte
        Dim cb As Long
        ReDim bt((MAX_PATH * 2 + 1) + LenB(tn))
        cb = UBound(bt) + 1
        lRet = WNetGetUniversalNameW(StrPtr(sLetter), UNIVERSAL_NAME_INFO_LEVEL, bt(0), cb)
        If lRet = S_OK Then
            CopyMemory tn, bt(0), LenB(tn)
            Dim sPath As String
            Dim cch As Long
            cch = lstrlenW(ByVal tn.lpUniversalName)
            If cch = 0 Then
                GetOldNetName = sLetter
                Exit Function
            End If
            sPath = String$(cch, 0)
            CopyMemory ByVal StrPtr(sPath), ByVal tn.lpUniversalName, cch * 2
            GetOldNetName = sLetter & " [" & sPath & "]"
            Exit Function
        Else
            Debug.Print "GetOldNetName->Error: " & lRet
        End If
        GetOldNetName = sLetter
    End Function
    If something isn't right let me know.
    WNetGetUniversalNameW is working now. Great job. A couple of slight differences between ucDriveCombo.Drive value and VB6.DriveListBox for network shares are:

    1. Yours includes a trailing backslash after the Share where VB's does not.
    2. Drive letter is lower case in VB6 but in yours it's upper case

    Name:  ucDriveComboShare fafalone working.jpg
Views: 158
Size:  17.5 KB
    Last edited by AAraya; Apr 25th, 2024 at 08:59 AM.

  12. #52

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    2 is certainly weird...

    Code:
        sOld = LCase$(sLetter) & ":"
        If PathIsNetworkPathW(StrPtr(sPath)) Then
            sOld = GetOldNetName(sOld)
    
    Private Function GetOldNetName(ByVal sLetter As String) As String
    
    (...)
    
    GetOldNetName = sLetter & " [" & sPath & "]"
    So how is it getting back to uppercase??

    I can't reproduce on my test machine; it's coming out lowercase for me. I guess try forcing it again by changing that final line to GetOldNetName = LCase$(sLetter) & " [" & sPath & "]". If *that* doesn't work, LCase is broken on your computer lol

    In the next update I'll do that just to be sure, and remove the backslash:

    Code:
    GetOldNetName = LCase$(sLetter) & " [" & RemoveBackslash(sPath) & "]"
    
    ...
    
    Private Function RemoveBackslash(sPath As String) As String
        If (Len(sPath) > 1) Then
            If Right$(sPath, 1) = "\" Then
                RemoveBackslash = Left$(sPath, Len(sPath) - 1)
                Exit Function
            End If
        End If
        RemoveBackslash = sPath
    End Function

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

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

    The LCase issue is probably one of my own creation. I copied and pasted your code into my own rather than redownloading from GitHub. I probably messed something up. No worries as I've got it resolved in my version.

  14. #54
    Hyperactive Member -Franky-'s Avatar
    Join Date
    Dec 2022
    Location
    Bremen Germany
    Posts
    267

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

    Hi fafalone
    I haven't been able to test your UC yet. But I looked at your code on GitHub and a property may still be missing. I also have 3 hidden network drives in my environment. These are not displayed in Explorer either. But they can be addressed normally via the drive letter. Maybe an additional property (ShowHiddenDrives) in your UC would be useful with which you can show or hide hidden drives in the UC.

  15. #55

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    It's not loading them from the shell display; it's loading them from GetLogicalDriveStrings; if it's mapped, it should show up.

    Although the issue might be admin/nonadmin. Drives have to be mapped in both or some registry key changed.

    Could you give it a try and let me know? Or what you had in mind to list hidden drives?

  16. #56
    Hyperactive Member -Franky-'s Avatar
    Join Date
    Dec 2022
    Location
    Bremen Germany
    Posts
    267

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

    Hi fafalone
    What I mean is this: https://www.tenforums.com/tutorials/...s-windows.html
    These drives are then not visible in Explorer. That's why an additional feature for your UC might be useful to hide these drives in your UC if you want to.
    Last edited by -Franky-; May 18th, 2024 at 02:24 AM.

  17. #57
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    544

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

    fafalone you've got a typo in your latest code on Github. The WS_TABSTOP constant has a random "Q" at the end of the value which causes a compile error.

  18. #58

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    In this project? Where? I just checked every file in the repo.

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

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

    Well that's weird. I'm not seeing it in GitHub code now either. I downloaded the code and opened it in VB6 and immediately had the issue. Oh well. Sorry for the false alarm.

  20. #60

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    No worries, had things like that happen to me too.

    @-Franky-, That's an Explorer policy so I'm pretty sure it's not going to impact this project, since I'm not enumerating with IShellFolder or IShellItem. Let me know for sure when you have a chance to check; I've just got too much open right now to log off to apply that key.

  21. #61
    Hyperactive Member -Franky-'s Avatar
    Join Date
    Dec 2022
    Location
    Bremen Germany
    Posts
    267

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

    Quote Originally Posted by fafalone View Post
    That's an Explorer policy so I'm pretty sure it's not going to impact this project, since I'm not enumerating with IShellFolder or IShellItem.
    That's exactly what I mean. The drive letters hidden via RegKey can be seen in your UC. There are good reasons why you hide drive letters from a user and therefore my suggestion is to allow these drive letters to be displayed in your UC using the ShowHiddenDrives property. The default would be to not allow these drive letters to be displayed in your UC.

  22. #62

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    Sorry misunderstood. Yeah I can add that.

  23. #63
    Hyperactive Member -Franky-'s Avatar
    Join Date
    Dec 2022
    Location
    Bremen Germany
    Posts
    267

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

    Quote Originally Posted by fafalone View Post
    Sorry misunderstood.
    No problem. Maybe I just didn't explain it correctly.

  24. #64

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    Project Updated - Version 1.6

    I've updated all versions and binaries for the project to v1.6, adding the feature to not show Explorer-hidden drives by default.

    Download from GitHub

  25. #65
    Hyperactive Member -Franky-'s Avatar
    Join Date
    Dec 2022
    Location
    Bremen Germany
    Posts
    267

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

    I think you could also check whether the drive letter is hidden using IShellItem::GetAttributes with the mask SFGAO_HIDDEN.

  26. #66

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    6,010

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

    Probably but then I'd have a complicated dependency system, since it would have to require oleexp.tlb in VB6 and WinDevLib (or local interface defs) in twinBASIC, or much more complicated DispCallFunc calls that are impenetrable to all but the most advanced VB/tB programmers.

    Once tB can export type libraries, I'll be able to make a single dependency system like that which covers both 32bit VB6 and 64bit twinBASIC (and 64bit VBA), and oleexp will go into bugfix-only deprecated status, but for now if it's a small project with only one or two easily avoided shell interfaces, makes more sense to do that when I'm writing for VB6 backwards compatibility.

Page 2 of 2 FirstFirst 12

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