2011-12-15 9 views
10

Además de this question y this one que pedí, más recientemente, pero sin los detalles correctos ... y por último this one que pedí en el foro Free Pascal específicamente ....¿Cómo llamar a una lista de los discos duros conectados físicamente usando Free Pascal o, en su defecto, Delphi?

¿Alguien puede proporcionarle orientación, ejemplos o una enlace a algo en algún lugar que explique cómo llamar a una lista de los discos duros conectados físicamente utilizando Free Pascal o, en su defecto, Delphi, independientemente de si los discos han sido montados o no por el sistema operativo. Se muestra un ejemplo en la captura de pantalla de lo que estoy tratando de lograr (lo que se muestra en esta captura de pantalla es por otro producto de software). Por lo tanto, no es lo que estoy tratando de hacer una lista de volúmenes lógicos (C: \, E: \ etc). Y si el disco tiene un sistema de archivos que el sistema operativo no puede montar, aún quiero ver el disco físico en la lista.

Destaco que los ejemplos de C \ C++ \ C Sharp son abundantes pero no lo que busco. Necesito principalmente el ejemplo de Free Pascal o, en su defecto, Delphi.

enter image description here

+2

+1 'esta pregunta muestra el esfuerzo de investigación' :-) ¿Has mirado el código fuente de' TDriveComboBox' bajo los componentes de Win3.1? – Johan

+0

Tengo una fuerte creencia de que kernel usa la numeración de contiguos para los discos phy, así que solo enumera hasta la falla – OnTheFly

Respuesta

11

Prueba la clase WMI Win32_DiskDrive, compruebe este código de ejemplo

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

Después de ejecutar este código obtendrá una salida como esta

enter image description here

+0

¿Por qué el voto a favor? – RRUZ

4

Para unidades montadas con letras de unidad, llame a la función Win32 ShellApi SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives). Declare la variable local Drives: PItemIdList. Esto es en la unidad llamada ShellAPI en delphi. Esperemos que exista una unidad similar en FreePascal.

Para las unidades desmontadas, tendrá que enumerar los controladores del dispositivo por la clase de controlador de dispositivo de GUID_DEVINTERFACE_DISK de alguna manera. El SetupAPI de Windows debería poder ayudarte.

Puede obtener SetupAPI.pas de los proyectos JEDI JCL o 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; 

A completa ejemplo DELPHI de trabajo incluyendo el código anterior y las unidades de API JEDI apropiado es here. Puedes adaptarlo a pascal y lazarus gratis con bastante facilidad.

+0

RRUZ - ¡muchas gracias! Acabo de probar el código que pegó en un nuevo programa de terminal básico con Lazarus 0.9.31 y FPC 2.5.1, y funcionó de inmediato sin tener que cambiar nada. Acabo de compilarlo y compilarlo, luego ejecuté el ejecutable compilado y, por supuesto, hace exactamente lo que necesito. Ahora puedo implementarlo en mi propio proyecto. ¡Me has ayudado a lograr algo que he pasado incontables horas intentando hacer! ¡Salud! –

Cuestiones relacionadas