如何使用 Free Pascal 调用物理连接的硬盘列表，或者如果失败，则使用 Delphi？

Question

进一步了解此问题和这个，我最近问过，但没有正确的细节......最后这个是我在 Free Pascal 论坛上专门问的......

可以任何人都可以向我提供指导、示例或某个地方的链接，解释如何使用 Free Pascal 调用物理连接的硬盘列表，或者如果失败，则使用 Delphi，无论磁盘是否已由操作系统安装或 不是？我试图实现的屏幕截图中显示了一个示例（此屏幕截图中显示的是另一个软件产品）。因此，提取逻辑卷列表（C:\、E:\ 等）并不是我想要做的。如果磁盘有操作系统无法安装的文件系统，我仍然想查看列出的物理磁盘。

我强调 C\C++\C Sharp 的例子很多，但不是我所追求的。我主要需要 Free Pascal 示例，或者，如果做不到这一点，则需要 Delphi。

Answer 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.    

运行此代码后，您将得到如下输出

Answer 2

对于带有驱动器号的已安装驱动器，请调用 Win32 ShellApi 函数 SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives)。声明局部变量Drives: PItemIdList。这是delphi 中名为ShellAPI 的单元。希望 FreePascal 中存在类似的单元。

对于未安装的驱动器，您必须通过 GUID_DEVINTERFACE_DISK 的设备驱动程序类以某种方式枚举设备驱动程序。 windows的SetupAPI应该可以帮助你。

您可以从 JEDI JCL 或 JEDI API 项目获取SetupAPI.pas。

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;

包含上述代码和相应 JEDI API 单元的完整工作 DELPHI 示例为 这里。您可以轻松地将其适应 free pascal 和 lazarus。