source: trunk/UPhysDrive.pas

unit UPhysDrive;

{$mode delphi}

interface

uses
  Classes, SysUtils, Contnrs, UFindFile, UCommon, Math
  {$IFDEF Windows},ActiveX,ComObj,Variants
  {$ENDIF};

type
  TDriveKind = (dkPhysical, dkFile);

  { TDriveInfo }

  TDriveInfo = class
  private
    FSectorSize: Integer;
    FSectorCount: Int64;
    FSize: Int64;
    function GetSectorCount: Int64;
    procedure SetSectorSize(AValue: Integer);
    procedure SetSize(AValue: Int64);
  public
    Kind: TDriveKind;
    Model: string;
    Path: string;
    constructor Create;
    procedure Assign(Source: TDriveInfo);
    property SectorSize: Integer read FSectorSize write SetSectorSize;
    property SectorCount: Int64 read GetSectorCount;
    property Size: Int64 read FSize write SetSize;
  end;

  { TDriveList }

  TDriveList = class(TObjectList)
    function FindByModel(Model: string): TDriveInfo;
    procedure LoadToStrings(Strings: TStrings);
    procedure Detect;
  private
    {$IFDEF Windows}
    procedure GetWin32DiskDriveInfo;
    {$ENDIF}
  end;

implementation

uses
  UPrefixMultiplier;

resourcestring
  SMinSectorSize = 'Minimum sector size is 1';

{ TDriveInfo }

procedure TDriveInfo.SetSectorSize(AValue: Integer);
begin
  if FSectorSize = AValue then Exit;
  if Avalue < 1 then
    raise Exception.Create(SMinSectorSize);
  FSectorSize := AValue;
  FSectorCount := Ceil(FSize / FSectorSize);
end;

function TDriveInfo.GetSectorCount: Int64;
begin
  Result := Ceil(FSize / FSectorSize);
end;

procedure TDriveInfo.SetSize(AValue: Int64);
begin
  if FSize = AValue then Exit;
  FSize := AValue;
end;

constructor TDriveInfo.Create;
begin
  FSectorSize := 1;
end;

procedure TDriveInfo.Assign(Source: TDriveInfo);
begin
  Path := Source.Path;
  Model := Source.Model;
  Size := Source.Size;
  FSectorCount := Source.FSectorCount;
  SectorSize := Source.SectorSize;
end;

{ TDriveList }

function TDriveList.FindByModel(Model: string): TDriveInfo;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TDriveInfo(Items[I]).Model <> Model) do Inc(I);
  if I < Count then Result := TDriveInfo(Items[I])
    else Result := nil;
end;

procedure TDriveList.LoadToStrings(Strings: TStrings);
var
  I: Integer;
  PrefixMultiplier: TPrefixMultiplier;
begin
  PrefixMultiplier := TPrefixMultiplier.Create(nil);
  try
    while Strings.Count > Count do
      Strings.Delete(Strings.Count - 1);
    while Strings.Count < Count do
      Strings.Add('');
    for I := 0 to Count - 1 do begin
      Strings[I] := TDriveInfo(Items[I]).Model + ' (' +
        PrefixMultiplier.Add(TDriveInfo(Items[I]).Size, BasePrefixMultipliers, 'B') + ')';
      Strings.Objects[I] := Items[I];
    end;
  finally
    PrefixMultiplier.Free;
  end;
end;

procedure TDriveList.Detect;
var
  NewDriveInfo: TDriveInfo;
  List: TStringList;
  I: Integer;
  FindFile: TFindFile;
begin
  Clear;
  {$IFDEF Linux}
  FindFile := TFindFile.Create(nil);
  FindFile.Path := '/sys/block';
  FindFile.FileMask := '*';
  FindFile.FileAttr := [ffaDirectory];
  FindFile.InSubFolders := False;
  List := FindFile.SearchForFiles;
  for I := 0 to List.Count - 1 do
  if (ExtractFileName(List[I]) <> '.') and (ExtractFileName(List[I]) <> '..') then begin
    if FileExists(List[I] + '/device') then begin
      NewDriveInfo := TDriveInfo.Create;
      NewDriveInfo.Kind := dkPhysical;
      NewDriveInfo.Model := Trim(LoadFileToStr(List[I] + '/device/model'));
      NewDriveInfo.SectorSize := StrToInt(Trim(LoadFileToStr(List[I] + '/queue/physical_block_size')));
      NewDriveInfo.Size := StrToInt64(Trim(LoadFileToStr(List[I] + '/size'))) * 512;
      NewDriveInfo.Path := '/dev/' + ExtractFileName(List[I]);
      Add(NewDriveInfo);
    end;
  end;
  {$ENDIF}
  {$IFDEF Windows}
  GetWin32DiskDriveInfo;
  {$ENDIF}
  // Drive located using filename
  NewDriveInfo := TDriveInfo.Create;
  NewDriveInfo.Kind := dkFile;
  NewDriveInfo.Model := 'File';
  NewDriveInfo.SectorSize := 4096;
  NewDriveInfo.Size := 0;
  NewDriveInfo.Path := '';
  Add(NewDriveInfo);
end;

{$IFDEF Windows}
procedure TDriveList.GetWin32DiskDriveInfo;
const
  WbemUser = '';
  WbemPassword = '';
  WbemComputer = 'localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator: OLEVariant;
  FWMIService: OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject: OLEVariant;
  oEnum: IEnumvariant;
  OutVar: LongWord;
  NewDriveInfo: TDriveInfo;
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, OutVar) = 0 do begin
    NewDriveInfo := TDriveInfo.Create;
    NewDriveInfo.Kind := dkPhysical;
    NewDriveInfo.Model := FWbemObject.Properties_.Item('Caption').Value;
    //NewDriveInfo.Model := FWbemObject.Properties_.Item('Model').Value;
    NewDriveInfo.Size := FWbemObject.Properties_.Item('Size').Value;
    NewDriveInfo.SectorSize := 4096;
    NewDriveInfo.Path := FWbemObject.Properties_.Item('DeviceID').Value;
    Add(NewDriveInfo);

    FWbemObject := Unassigned;
  end;
end;
{$ENDIF}


end.