Question

除了this question和this one之外我最近问过但没有正确的具体内容......最后this one我在Free Pascal论坛专门询问了...... < / p>

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

我强调C \ C ++ \ C夏普的例子很丰富，但不是我追求的。我主要需要Free Pascal示例，或者说，失败了，Delphi。

enter image description here

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.

运行此代码后，您将获得这样的输出

enter image description here

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示例为here。你可以很容易地将它改编成免费的帕斯卡和拉撒路。

如何使用Free Pascal调用物理连接的硬盘列表，或者，如果不这样，Delphi？

2 个答案: