Delphi - Как получить список USB Съемные жесткие диски и памяти памяти?
-
02-10-2019 - |
Вопрос
В моем приложении (Delphi) мне нужно перечислить все устройства для хранения USB. Это можно либо флэш-память памяти или Внешние накопители.
Eсть Jvcl
компонент JvDriveCombo
, и имеет DriveType
Имущество - проблема в том, что если я выбираю DriveType := Fixed
Затем в дополнение к внешнему приводу он также перечисляет внутренние диски (C:\
, D:\
так далее). Тем не менее, я хочу перечислить внешние диски.
Я полагаю, что есть функция устройстваоконтрола (я видел это на MSDN), но я понятия не имею о том, как его использовать.
Интересно, может ли кто-нибудь помочь мне с правильным способом / кодом для перечисления устройств для хранения USB?
Спасибо.
РЕДАКТИРОВАТЬ:
Я только что нашел какой-то образец код и размещаю его здесь:
uses .... jwawinbase, JwaWinIoctl;
procedure TForm1.Button1Click(Sender: TObject);
var
DriveCmdStr: string;
DriveHandle: THandle;
ADriveLetter: string;
hp: STORAGE_HOTPLUG_INFO;
rlen: DWORD;
begin
ADriveLetter := 'H';
DriveCmdStr := Format('\\.\%s:', [ADriveLetter]);
DriveHandle := CreateFile(PChar(DriveCmdStr), GENERIC_READ, FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if DriveHandle = INVALID_HANDLE_VALUE then
Exit;
DeviceIoControl(DriveHandle, IOCTL_STORAGE_GET_HOTPLUG_INFO, nil, 0, @hp,
SizeOf(hp), @rlen, nil);
CloseHandle(DriveHandle);
if hp.MediaRemovable then
showmessage('media removable');
end;
Теперь я хотел бы просто знать, как перечислять все буквы привода. Какой является наиболее эффективной функцией?
Решение
{$MINENUMSIZE 4}
const
IOCTL_STORAGE_QUERY_PROPERTY = $002D1400;
type
STORAGE_QUERY_TYPE = (PropertyStandardQuery = 0, PropertyExistsQuery, PropertyMaskQuery, PropertyQueryMaxDefined);
TStorageQueryType = STORAGE_QUERY_TYPE;
STORAGE_PROPERTY_ID = (StorageDeviceProperty = 0, StorageAdapterProperty);
TStoragePropertyID = STORAGE_PROPERTY_ID;
STORAGE_PROPERTY_QUERY = packed record
PropertyId: STORAGE_PROPERTY_ID;
QueryType: STORAGE_QUERY_TYPE;
AdditionalParameters: array [0..9] of AnsiChar;
end;
TStoragePropertyQuery = STORAGE_PROPERTY_QUERY;
STORAGE_BUS_TYPE = (BusTypeUnknown = 0, BusTypeScsi, BusTypeAtapi, BusTypeAta, BusType1394, BusTypeSsa, BusTypeFibre,
BusTypeUsb, BusTypeRAID, BusTypeiScsi, BusTypeSas, BusTypeSata, BusTypeMaxReserved = $7F);
TStorageBusType = STORAGE_BUS_TYPE;
STORAGE_DEVICE_DESCRIPTOR = packed record
Version: DWORD;
Size: DWORD;
DeviceType: Byte;
DeviceTypeModifier: Byte;
RemovableMedia: Boolean;
CommandQueueing: Boolean;
VendorIdOffset: DWORD;
ProductIdOffset: DWORD;
ProductRevisionOffset: DWORD;
SerialNumberOffset: DWORD;
BusType: STORAGE_BUS_TYPE;
RawPropertiesLength: DWORD;
RawDeviceProperties: array [0..0] of AnsiChar;
end;
TStorageDeviceDescriptor = STORAGE_DEVICE_DESCRIPTOR;
function GetBusType(Drive: AnsiChar): TStorageBusType;
var
H: THandle;
Query: TStoragePropertyQuery;
dwBytesReturned: DWORD;
Buffer: array [0..1023] of Byte;
sdd: TStorageDeviceDescriptor absolute Buffer;
OldMode: UINT;
begin
Result := BusTypeUnknown;
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
H := CreateFile(PChar(Format('\\.\%s:', [AnsiLowerCase(Drive)])), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if H <> INVALID_HANDLE_VALUE then
begin
try
dwBytesReturned := 0;
FillChar(Query, SizeOf(Query), 0);
FillChar(Buffer, SizeOf(Buffer), 0);
sdd.Size := SizeOf(Buffer);
Query.PropertyId := StorageDeviceProperty;
Query.QueryType := PropertyStandardQuery;
if DeviceIoControl(H, IOCTL_STORAGE_QUERY_PROPERTY, @Query, SizeOf(Query), @Buffer, SizeOf(Buffer), dwBytesReturned, nil) then
Result := sdd.BusType;
finally
CloseHandle(H);
end;
end;
finally
SetErrorMode(OldMode);
end;
end;
procedure GetUsbDrives(List: TStrings);
var
DriveBits: set of 0..25;
I: Integer;
Drive: AnsiChar;
begin
List.BeginUpdate;
try
Cardinal(DriveBits) := GetLogicalDrives;
for I := 0 to 25 do
if I in DriveBits then
begin
Drive := Chr(Ord('a') + I);
if GetBusType(Drive) = BusTypeUsb then
List.Add(Drive);
end;
finally
List.EndUpdate;
end;
end;
Другие советы
Вы можете получить доступ к этой информации, используя WMI. Если вы используете этот SQL, вы можете получить доступ к информации о установленных дисках.
select * from Win32_diskdrive where size<>NULL
Этот код вносит информацию о дисках.
procedure TForm1.DoInventario(aWSQL:string; var mmResult:TMemo);
var
Locator:ISWbemLocator;
Services:ISWbemServices;
SObject:ISWbemObject;
ObjSet:ISWbemObjectSet;
Enum:IEnumVariant;
TempObj:OleVariant;
Value:Cardinal;
TS:TStrings;
begin
try
Locator := CoSWbemLocator.Create();
// Conectar con el Servicio de WMI
Services := Locator.ConnectServer(
STR_LOCALHOST, {ordenador local}
STR_CIM2_ROOT, {root}
STR_EMPTY, STR_EMPTY, {usuario y password -en local no son necesarios-}
STR_EMPTY,STR_EMPTY, 0, nil);
// Acceder a los datos
ObjSet := Services.ExecQuery(aWSQL, 'WQL',
wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
Enum := (ObjSet._NewEnum) as IEnumVariant;
// Hemos encontrado algun objeto?
while (Enum.Next(1, TempObj, Value) = S_OK) do begin
SObject := IUnknown(TempObj) as ISWBemObject;
// encontrado?
if (SObject <> nil) then begin
// Acceder a la propiedad
SObject.Properties_;
// Cargamos las propiedades
TS := TStringList.Create();
try
TS.Add(SObject.GetObjectText_(0));
// lo pasamos al memo
mmResult.Lines.Text := mmResult.Lines.Text + TS.Text;
finally
FreeAndNil(TS);
end;
end;
end;
except
// Recuperar excepciones
end;
end;
Вы должны добавить ActiveX и wbemscripting_tlb (это необходимо импортировать) в вашем использовании. С этим вы можете получить доступ к всей информации дисков.
Чтобы извлечь письмо всей диска, вы можете комбинировать (извлекать можно сделать с тем же кодом) Доступ к классам Win32_logialdisktopartition. а также Win32_diskdrive..
select * from Win32_LogicalDiskToPartition
select * from Win32_DiskDrive
Если вы ищете WMI, вы можете найти более связанные коды.
С уважением.
Я не уверен, что вы просто хотите перечислять буквы привода? Внутренний цикл ниже, проходит через все буквы, независимо от того, есть ли драйв для этого письма.
Или, если вы ищете другой способ найти съемные диски, есть функция для этого ниже. (Ваш может быть лучше ...) Удивительно, на моем тесте Windows.GetDrivetype не рассматривает диски CD как съемное. USB-накопители помечаются как съемные, как ожидают.
Function RemovableDrive(Drive: char): Boolean;
begin
Result := (Windows.GetDriveType(PChar(Drive + ':\')) = Windows.Drive_Removable);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Drive: Char;
begin
for Drive := 'A' to 'Z' do
Memo1.Lines.Add('Drive: ' + Drive + ' is ' + BoolToStr(RemovableDrive(Drive), TRUE));
end;