ADD: Show portable devices in the drive list (issue #1211)

This commit is contained in:
Alexander Koblov 2023-08-07 21:51:02 +03:00
commit c8c2d0faf8
3 changed files with 84 additions and 4 deletions

View file

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Dialogs,
Windows, ShlObj,
uFileSourceProperty,
uFileSourceProperty, uDrive, uDrivesList,
uVirtualFileSource, uFileProperty, uFileSource,
uFileSourceOperation, uFile, uFileSourceOperationTypes;
@ -42,6 +42,7 @@ type
class function GetMainIcon(out Path: String): Boolean; override;
class function RootName: String;
class procedure ListDrives(DrivesList: TDrivesList; UpperCase: Boolean);
function CreateFolder(AParent: IShellFolder2; const Name: String): HRESULT;
function FindFolder(const Path: String; out AValue: IShellFolder2): HRESULT;
@ -143,6 +144,72 @@ begin
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
OleCheckUTF8(SHGetFolderLocation(0, CSIDL_DRIVES, 0, 0, {%H-}DrivesPIDL));
Result:= GetDisplayName(DesktopFolder, DrivesPIDL, SHGDN_INFOLDER);
CoTaskMemFree(DrivesPIDL);
end;
class procedure TShellFileSource.ListDrives(DrivesList: TDrivesList;
UpperCase: Boolean);
const
SFGAOF_DEFAULT = SFGAO_FILESYSTEM or SFGAO_FOLDER;
const
UPPER_LETTER: array[0..11] of String = ('Ù', 'Ú', 'Û', 'Ü', 'Ũ', 'Ū', 'Ŭ', 'Ů', 'Ű', 'Ų', 'Ȕ', 'Ȗ');
LOWER_LETTER: array[0..11] of String = ('ù', 'ú', 'û', 'ü', 'ũ', 'ū', 'ŭ', 'ů', 'ű', 'ų', 'ȕ', 'ȗ');
var
ADrive: PDrive;
RootPath: String;
DeviceId: String;
PIDL: PItemIDList;
rgfInOut: LongWord;
Index: Integer = 0;
NumIDs: LongWord = 0;
AFolder: IShellFolder2;
EnumIDList: IEnumIDList;
DrivesPIDL: PItemIDList;
DesktopFolder: IShellFolder;
begin
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
OleCheckUTF8(SHGetFolderLocation(0, CSIDL_DRIVES, 0, 0, {%H-}DrivesPIDL));
try
OleCheckUTF8(DesktopFolder.BindToObject(DrivesPIDL, nil, IID_IShellFolder2, Pointer(AFolder)));
OleCheckUTF8(AFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_STORAGE, EnumIDList));
RootPath:= '\\\' + GetDisplayName(DesktopFolder, DrivesPIDL, SHGDN_INFOLDER);
while (EnumIDList.Next(1, PIDL, NumIDs) = S_OK) do
try
rgfInOut:= SFGAOF_DEFAULT;
if Succeeded(AFolder.GetAttributesOf(1, PIDL, rgfInOut)) then
begin
if (SFGAOF_DEFAULT and rgfInOut) = SFGAO_FOLDER then
begin
DeviceId:= GetDisplayName(AFolder, PIDL, SHGDN_FORPARSING);
if Pos('\\?\usb', DeviceId) > 0 then
begin
New(ADrive);
ZeroMemory(ADrive, SizeOf(TDrive));
if UpperCase then
ADrive^.DisplayName:= UPPER_LETTER[Index]
else begin
ADrive^.DisplayName:= LOWER_LETTER[Index];
end;
ADrive^.IsMounted:= True;
ADrive^.DeviceId:= DeviceId;
ADrive^.DriveType:= dtSpecial;
ADrive^.IsMediaAvailable:= True;
ADrive^.DriveLabel:= GetDisplayNameEx(AFolder, PIDL, SHGDN_INFOLDER);
ADrive^.Path:= RootPath + PathDelim + ADrive^.DriveLabel;
DrivesList.Add(ADrive);
Inc(Index);
if (Index > High(LOWER_LETTER)) then Break;
end;
end;
end;
finally
CoTaskMemFree(PIDL);
end;
finally
CoTaskMemFree(DrivesPIDL);
end;
end;
function TShellFileSource.FindObject(const AObject: String; out

View file

@ -950,7 +950,7 @@ uses
fOptionsToolbarBase, fOptionsToolbarMiddle, fEditor, uColumns, StrUtils, uSysFolders,
uColumnsFileView, dmHigh
{$IFDEF MSWINDOWS}
, uNetworkThread
, uShellFileSource, uNetworkThread
{$ENDIF}
;
@ -4876,6 +4876,10 @@ begin
end;
end;
end;
if (Win32MajorVersion > 5) then
begin
TShellFileSource.ListDrives(DrivesList, gUpperCaseDriveLetter);
end;
{$ENDIF}
UpdateDriveList(DrivesList);
@ -6350,7 +6354,7 @@ begin
for I := 0 to DrivesList.Count - 1 do
begin
if DrivesList[I]^.DriveType = dtSpecial then
if (DrivesList[I]^.DriveType = dtSpecial) and (Length(Address) > 0) then
begin
if Pos(Address, DrivesList[I]^.Path) = 1 then
Exit(I);

View file

@ -2307,6 +2307,7 @@ end;
function TPixMapManager.GetDriveIcon(Drive : PDrive; IconSize : Integer; clBackColor : TColor; LoadIcon: Boolean) : Graphics.TBitmap;
{$IFDEF MSWINDOWS}
var
PIDL: PItemIDList;
SFI: TSHFileInfoW;
uFlags: UINT;
iIconSmall,
@ -2341,7 +2342,15 @@ begin
end;
uFlags := uFlags or SHGFI_ICON;
if (not LoadIcon) and (Drive^.DriveType = dtNetwork) and SHGetStockIconInfo(SIID_DRIVENET, uFlags, psii) then
if (Drive^.DriveType = dtSpecial) then
begin
if Succeeded(SHParseDisplayName(PWideChar(CeUtf8ToUtf16(Drive^.DeviceId)), nil, PIDL, 0, nil)) then
begin
SHGetFileInfoW(PWideChar(PIDL), 0, SFI, SizeOf(SFI), uFlags or SHGFI_PIDL);
CoTaskMemFree(PIDL);
end;
end
else if (not LoadIcon) and (Drive^.DriveType = dtNetwork) and SHGetStockIconInfo(SIID_DRIVENET, uFlags, psii) then
SFI.hIcon:= psii.hIcon
else if (SHGetFileInfoW(PWideChar(CeUtf8ToUtf16(Drive^.Path)), 0, SFI, SizeOf(SFI), uFlags) = 0) then begin
SFI.hIcon := 0;