Как вызвать список физически подключенных жестких дисков, используя Free Pascal, или, в противном случае, Delphi?

В дополнение к этот вопрос и этот, который я попросил совсем недавно, но без правильной специфики... и, наконец, этот, который я задал на форуме Free Pascal специально....

Может ли кто-нибудь предоставить мне руководство, примеры или ссылку на что-то где-то, что объясняет, как вызвать список физически подключенных жестких дисков с помощью Free Pascal или, если это не так, Delphi, независимо от того, были ли диски установлены операционной системы или нет? Пример показан на скриншоте того, что я пытаюсь достичь (то, что показано на этом скриншоте, - это другой программный продукт). Поэтому вытащить список логических томов (C: \, E:\etc) не то, что я пытаюсь сделать. И если на диске есть файловая система, которую операционная система не может смонтировать, я все равно хочу видеть указанный физический диск.

Я подчеркиваю, что примеры C\С++\C Sharp являются plentifull, но не то, что я хочу. Мне нужен, прежде всего, пример Free Pascal, или, в противном случае, Delphi.

Ответы

Ответ 1

Попробуйте Win32_DiskDrive класс WMI, проверьте этот пример кода

{$mode objfpc}{$H+}
uses
  SysUtils,ActiveX,ComObj,Variants;
{$R *.res}

// The Win32_DiskDrive class represents a physical disk drive as seen by a computer running the Win32 operating system. Any interface to a Win32 physical disk drive is a descendent (or member) of this class. The features of the disk drive seen through this object correspond to the logical and management characteristics of the drive. In some cases, this may not reflect the actual physical characteristics of the device. Any object based on another logical device would not be a member of this class.
// Example: IDE Fixed Disk.

procedure  GetWin32_DiskDriveInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : Variant;
  oEnum         : IEnumvariant;
  sValue        : string;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, nil) = 0 do
  begin
    sValue:= FWbemObject.Properties_.Item('Caption').Value;
    Writeln(Format('Caption        %s',[sValue]));// String
    sValue:= FWbemObject.Properties_.Item('DeviceID').Value;
    Writeln(Format('DeviceID       %s',[sValue]));// String
    sValue:= FWbemObject.Properties_.Item('Model').Value;
    Writeln(Format('Model          %s',[sValue]));// String
    sValue:= FWbemObject.Properties_.Item('Partitions').Value;
    Writeln(Format('Partitions     %s',[sValue]));// Uint32
    sValue:= FWbemObject.Properties_.Item('PNPDeviceID').Value;
    Writeln(Format('PNPDeviceID    %s',[sValue]));// String
    sValue:= FormatFloat('#,', FWbemObject.Properties_.Item('Size').Value / (1024*1024));
    Writeln(Format('Size           %s mb',[sValue]));// Uint64

    Writeln;
    FWbemObject:= Unassigned;
  end;
end;

begin
  try
    GetWin32_DiskDriveInfo;
  except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
  end;
  Writeln('Press Enter to exit');
  Readln;
end.

После запуска этого кода вы получите такой вывод, как

Ответ 2

Для подключенных дисков с буквами диска вызовите функцию Win32 ShellApi SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives). Объявить локальную переменную Drives: PItemIdList. Это в подразделе с именем ShellAPI в delphi. Надеюсь, аналогичная единица существует в FreePascal.

Для несмонтированных дисков вам придется перечислить драйверы устройств с помощью класса драйвера устройства GUID_DEVINTERFACE_DISK. SetupAPI окон должен помочь вам.

Вы можете получить SetupAPI.pas из проектов JEDI JCL или JEDI API.

procedure GetListFromSetupApi(aStrings: TStrings);
var
  iDev: Integer;
  RegDataType: Cardinal;
  reqSize:DWORD;
  prop:Cardinal;
  pszData:PByte;
  hinfo:   HDEVINFO;
  bResult: BOOL;
  devinfo: SP_DEVINFO_DATA;
  dwRequiredSize,dwPropertyRegDataType,dwAllocSz:Cardinal;
begin
  LoadSetupApi;
  if not Assigned(SetupDiGetClassDevs) then
    Exit;

  hinfo := SetupDiGetClassDevs(@GUID_DEVINTERFACE_DISK, nil, HWND(nil),
                               DIGCF_DEVICEINTERFACE or DIGCF_PRESENT or DIGCF_PROFILE);

  devinfo.ClassGuid.D1 := 0;
  devinfo.ClassGuid.D2 := 0;
  devinfo.ClassGuid.D3 := 0;
  devinfo.cbSize := SizeOf(SP_DEVINFO_DATA);

  iDev := 0;
   while SetupDiEnumDeviceInfo(hinfo, iDev, devinfo) do
    begin

    dwRequiredSize := 0;

    prop := SPDRP_PHYSICAL_DEVICE_OBJECT_NAME;
    // results on my computer:
    // \Device\Ide\IAAStorageDevice-1
    // \Device\Ide\IAAStorageDevice-2
    // \Device\0000008a                 (this one is a usb disk, use SPDRP_ENUMERATOR_NAME, returns USBSTOR)

//   prop := SPDRP_ENUMERATOR_NAME; // results: IDE, USBSTOR, or other bus type.

//   prop := SPDRP_LOCATION_INFORMATION; // a number like 1,2,3.


    { SPDRP_DRIVER - driver guid }
    { Get Size of property }
     SetupDiGetDeviceRegistryProperty
                (hinfo,
                devinfo,
                prop,
                dwPropertyRegDataType,
                nil,
                0,
                dwRequiredSize);   { dwRequiredSize should be around 88 after this point, in unicode delphi }

     if dwRequiredSize>0 then begin

        dwAllocSz := dwRequiredSize+4;
        pszData := AllocMem(dwAllocSz);
        bResult := SetupDiGetDeviceRegistryProperty
                (hinfo,
                devinfo,
                prop,
                dwPropertyRegDataType,
                pszData,
                dwAllocSz,
                dwRequiredSize);

        aStrings.Add(IntToStr(aStrings.Count)+': '+PChar(pszData));
        FreeMem(pszData);

    end;
    inc(iDev);
  end;
  SetupDiDestroyDeviceInfoList(hinfo);
end;

Полный рабочий пример DELPHI, включающий вышеуказанный код и соответствующие модули JEDI API, здесь. Вы можете легко адаптировать его к свободному паскалю и лазару.