Updates for v1.4

fafalone · Apr 25, 2024 · f2801be · f2801be
1 parent db56dae
commit f2801be
Showing 1 changed file with 77 additions and 8 deletions.
diff --git a/ucDriveCombo.twin b/ucDriveCombo.twin
@@ -9,7 +9,7 @@ Class ucDriveCombo
 Option Explicit
 
 '********************************************************************
-' ucDriveCombo v1.3
+' ucDriveCombo v1.4
 ' A Modern DriveList Replacement
 ' by Jon Johnson
 '
@@ -33,6 +33,12 @@ Option Explicit
 '   -Can optionally classify USB hard drives as removable.
 '
 ' 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.
+'
 '  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
@@ -102,7 +108,12 @@ Private Const WC_COMBOBOXEX = "ComboBoxEx32"
     Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, ByRef lpRect As RECT) As Long
     Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As LongPtr) As LongPtr
     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
-    #Else
+    Private Declare PtrSafe Function PathIsNetworkPathW Lib "shlwapi.dll" (ByVal lpszPath As LongPtr) As BOOL
+    Private Declare PtrSafe Function PathIsUNCW Lib "shlwapi.dll" (ByVal lpszPath As LongPtr) As BOOL
+    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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
+    Private Declare PtrSafe Function lstrlenW Lib "kernel32" (lpString As Any) As Long
+#Else
     Private Enum LongPtr
         vbNullPtr
     End Enum
@@ -136,6 +147,11 @@ Private Const WC_COMBOBOXEX = "ComboBoxEx32"
     Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, ByRef lpRect As RECT) As Long
     Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As LongPtr) As LongPtr
     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 Declare Function PathIsNetworkPathW Lib "shlwapi.dll" (ByVal lpszPath As LongPtr) As BOOL
+    Private Declare Function PathIsUNCW Lib "shlwapi.dll" (ByVal lpszPath As LongPtr) As BOOL
+    Private Declare 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
+    Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
     #End If
 
 Private Type RECT
@@ -159,6 +175,14 @@ Private Const WM_DEVICECHANGE = &H0219
 Private Const NFR_UNICODE = 2
 Private Const LOGPIXELSY = 90
 
+Private Enum NETWK_NAME_INFOLEVEL
+    UNIVERSAL_NAME_INFO_LEVEL = &H00000001
+    REMOTE_NAME_INFO_LEVEL = &H00000002
+End Enum
+Private Type UNIVERSAL_NAME_INFOW
+    lpUniversalName As LongPtr
+End Type
+
 Private Enum FileShareMode
     FILE_SHARE_READ = &H00000001
     FILE_SHARE_WRITE = &H00000002
@@ -978,9 +1002,10 @@ Private Function GetSysImageList(uFlags As SHGFI_flags) As LongPtr
     hEdit = SendMessage(hMain, CBEM_GETEDITCONTROL, 0, ByVal 0&)
 
     SendMessage hEdit, EM_SETREADONLY, 1&, ByVal 0&
+
+    Call SendMessage(hMain, CBEM_SETIMAGELIST, 0, ByVal himl)
 
     If Ambient.UserMode Then
-        Call SendMessage(hMain, CBEM_SETIMAGELIST, 0, ByVal himl)
         Subclass2 hMain, AddressOf ucDriveComboWndProc, hMain, ObjPtr(Me)
         RefreshDriveList
         Dim tFilter As DEV_BROADCAST_DEVICEINTERFACE
@@ -992,6 +1017,20 @@ Private Function GetSysImageList(uFlags As SHGFI_flags) As LongPtr
         tFilter.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE
         tFilter.dbcc_classguid = GUID_DEVINTERFACE_VOLUME
         hNotify = RegisterDeviceNotification(hMain, tFilter, DEVICE_NOTIFY_WINDOW_HANDLE)
+    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, Ambient.DisplayName, nIcon
+        SendMessage hMain, CB_SETCURSEL, 0, ByVal 0
     End If
 
     If mEnabled = False Then
@@ -1135,15 +1174,45 @@ Private Sub SetOldName(sPath As String, sLetter As String, nIdx As Long)
     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 & "]"
+    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
 Private Function CBX_InsertItem(ByVal hCBoxEx As LongPtr, sText As String, Optional iImage As Long = -1, Optional iOverlay As Long = -1, Optional lParam As Long = 0, Optional iItem As Long = -1, Optional iIndent As Long = 0, Optional iImageSel As Long = -1) As Long
 
     Dim cbxi As COMBOBOXEXITEMW