Làm thế nào để gọi một danh sách các đĩa cứng gắn liền với vật lý bằng cách sử dụng Free Pascal, hoặc, thất bại đó, Delphi?

Question

Tiếp tục để this question và this one mà tôi hỏi gần đây hơn nhưng không có chi tiết cụ thể chính xác ... và cuối cùng this one mà tôi hỏi qua diễn đàn của Free Pascal đặc biệt ....

bất cứ ai có thể cung cấp cho tôi với sự hướng dẫn, ví dụ hoặc liên kết đến một cái gì đó ở đâu đó giải thích làm thế nào để gọi một danh sách các đĩa cứng vật lý kèm theo bằng cách sử dụng miễn phí Pascal, hoặc, không, Delphi, bất kể cho dù đĩa đã được gắn kết bởi hệ điều hành hay không? Một ví dụ được hiển thị trong ảnh chụp màn hình của những gì tôi đang cố gắng để đạt được (những gì được hiển thị trong ảnh chụp màn hình này là bởi một sản phẩm phần mềm khác). Vì vậy, kéo một danh sách các khối tin hợp lý (C: \, E: \ etc) không phải là những gì tôi đang cố gắng làm. Và nếu đĩa có hệ thống tệp mà hệ điều hành không thể gắn kết, tôi vẫn muốn xem đĩa vật lý được liệt kê.

Tôi nhấn mạnh rằng các ví dụ của C \ C++ \ C Sharp rất đa dạng nhưng không phải là những gì tôi theo sau. Tôi cần chủ yếu ví dụ Free Pascal, hoặc, thất bại, Delphi.

Answer 1

Thử WMI lớp Win32_DiskDrive, kiểm tra mẫu mã này

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

Sau khi chạy mã này, bạn sẽ nhận được một kết quả như thế này

Answer 2

Đối với ổ đĩa gắn với các ký tự ổ đĩa, hãy gọi hàm Win32 ShellApi SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives). Khai báo biến địa phương Drives: PItemIdList. Đây là đơn vị có tên ShellAPI trong delphi. Hy vọng rằng một đơn vị tương tự tồn tại trong FreePascal.

Đối với các ổ đĩa chưa được gắn kết, bạn sẽ phải liệt kê các trình điều khiển thiết bị theo lớp trình điều khiển thiết bị là GUID_DEVINTERFACE_DISK bằng cách nào đó. SetupAPI của cửa sổ sẽ có thể giúp bạn.

Bạn có thể lấy SetupAPI.pas từ dự án JEDI JCL hoặc 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; 

Ví dụ DELPHI làm việc đầy đủ bao gồm mã trên và các đơn vị API JEDI thích hợp là here. Bạn có thể thích nghi nó với pascal và lazarus miễn phí khá dễ dàng.