How to call a list of the physically attached hard disks using Free Pascal, or, failing that, Delphi?

孤街浪徒 提交于 2019-12-01 16:35:10
RRUZ

Try the Win32_DiskDrive WMI class, check this sample code

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

After of running this code you will get a output like this

For mounted drives with drive letters, call Win32 ShellApi function SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives). Declare local variable Drives: PItemIdList. This is in unit named ShellAPI in delphi. Hopefully a similar unit exists in FreePascal.

For unmounted drives, you will have to enumerate the device drivers by the device driver class of GUID_DEVINTERFACE_DISK somehow. The SetupAPI of windows should be able to help you.

You can get SetupAPI.pas from the JEDI JCL or JEDI API projects.

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;

A complete working DELPHI example including the above code and the appropriate JEDI API units is here. You can adapt it to free pascal and lazarus pretty easily.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!