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

Question

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

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

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

Answer 1

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

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

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

Answer 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 - здесь .Вы можете легко приспособить его к свободному паскалю и лазарю.