Delphi - How to get list of USB removable hard dri

2019-03-08 16:28发布

问题:

In my application (Delphi), I need to list all the USB storage devices. These can be either flash memory sticks or external storage drives.

There is a Jvcl component JvDriveCombo, and it has the DriveType property - the problem is if I select DriveType := Fixed then in addition to the external drive, it also lists the internal drives (C:\, D:\ etc). However, I only want to list the external drives.

I believe there is DeviceIoControl function (I saw it on MSDN) but I have no idea of how to use it.

I wonder if anyone can help me with the proper way / code to list USB storage devices?

Thanks.

EDIT:

I just found some sample code and am posting it here:

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;

Now I would like to just know how to enumerate all the drive letters. Which is the most efficient function?

回答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;


回答2:

You can access this information using WMI. If you use this SQL you can access information about installed disks.

select * from Win32_diskdrive where size<>NULL

This code retrive information about drives.

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;

You must add ActiveX and WbemScripting_TLB (this must be imported) in your uses. With this you can access all information of the disks.

To retrive the letter of all disk you can combine (retrieve can do with the same code) the access to the classes Win32_LogicalDiskToPartition and Win32_DiskDrive.

select * from Win32_LogicalDiskToPartition
select * from Win32_DiskDrive

If you search WMI you can find more related codes.

Regards.



回答3:

I'm not sure if you're just looking to enumerate drive letters? The for-loop below does that, going through all letters, regardless of whether there's a drive for that letter.

Or, if you're looking for a different way to find removable drives, there's a function for that below, too. (Yours may be better...) Surprisingly, on my test, Windows.GetDriveType does NOT consider CD drives as removable. USB drives are flagged as removable, as one would expect.

  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;