diff --git a/ucDriveCombo.twin b/ucDriveCombo.twin index 6f06fbd..9cce58b 100644 --- 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