Delphi - Как получить список USB Съемные жесткие диски и памяти памяти?

Question

В моем приложении (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;

Теперь я хотел бы просто знать, как перечислять все буквы привода. Какой является наиболее эффективной функцией?

Answer 1

{$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;

Answer 2

Вы можете получить доступ к этой информации, используя 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, вы можете найти более связанные коды.

С уважением.

Answer 3

Я не уверен, что вы просто хотите перечислять буквы привода? Внутренний цикл ниже, проходит через все буквы, независимо от того, есть ли драйв для этого письма.

Или, если вы ищете другой способ найти съемные диски, есть функция для этого ниже. (Ваш может быть лучше ...) Удивительно, на моем тесте 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;