Partitionen grafisch anzeigen wie Windows Datenträgerverwaltung

[Alter Mann]

Moin, Moin

Keiner ist Perfekt, daher gibt es Änderungen in den beiden Units.

comHDDInfoGui

Delphi-Quellcode:

procedure   TDeviceInfoPanel.ShowDeviceData;

  function ConvertSerialNumber(Input : String) : String;
  var
    I  : Integer;
    CC : Char;
  begin
    Result := '';
    I      := 1;
    while I < Length(Input) do
    begin
      CC := Char(StrToInt(Format('$%s%s',[Input[I], Input[I+1]])));
      Inc(I, 2);
      if CC <> ' ' then            // change CC <> '' to CC <> ' ' 20.04.2013
        Result := Result + CC;
    end;
  end;

  // added FormatModell 20.04.2013
  function FormatModell(Input : String) : String;
  var
    St : String;
  begin
    St := Copy(Input, POS(' ', Input) + 1, Length(Input));
    St := Copy(St, 1, POS(' ', St));
    Result := St;
  end;

begin
  if (FDeviceInfoRecord <> nil) then
  begin
    with FDeviceInfoRecord^ do
    begin
      FPartitionMapPanel.DriveLayout  := @LayoutRecord;
      FPartitionMapPanel.DeviceLength := DeviceLength;
      FPartitionMapPanel.VolumenInfo  := @InfoRecord;
    end;

    lbSerialNumberInfo.Caption  := ConvertSerialNumber(FDeviceInfoRecord.IdentRecord.SerialNumber);
    lbFirmWareInfo.Caption      := FDeviceInfoRecord.IdentRecord.FirmwareRev;
    lbModelNameInfo.Caption     := FormatModell(FDeviceInfoRecord.IdentRecord.ModelNumber);
    lbDeviceSizeInfo.Caption    := Format('%d %s', [LBASizeToGB(FDeviceInfoRecord.DeviceLength), SizeFormatStr(FDeviceInfoRecord.DeviceLength)]);
    lbInterfaceInfo.Caption     := FDeviceInfoRecord.IdentRecord.InterfaceType;

    FPartitionMapPanel.ShowPartitionData;
  end;
end;

procedure   TPartitionMapPanel.ShowPartitionData;
var
  I, J, RF  : Integer;
begin
  RF := FDeviceLength div (Width - 2);      
  for I := 0 to FDriveLayoutRecord.PartitionCount - 1 do
  begin
    J := FPartitionList.Add(TPartitionInfoPanel.Create(Self));
    with TPartitionInfoPanel(FPartitionList[J]) do
    begin
      Left          := 2 + Round(FDriveLayoutRecord.PartitionEntry[I].StartingOffset  / RF); // change 1 to 2 20.04.2013
      Top           := 2;
      Width         := Round(FDriveLayoutRecord.PartitionEntry[I].PartitionLength / RF) -1;
      Height        := 75;
      Index         := J;
      InfoID        := I;
      OnCreateEvent := CreatePartitionPanel;
    end;
    TPartitionInfoPanel(FPartitionList[J]).Parent  := Self;
  end;
end;

procedure   TPartitionInfoPanel.ShowDeviceData;
begin
  FDriveVolume.Caption := Format('%s (%s:\)', [FInfoVolumeRecord.VolumeName, FInfoVolumeRecord.DriveLetter]);
  FFileSystem.Caption  := Format('%d %s', [LBASizeToGB(FInfoVolumeRecord.VolumeSize), SizeFormatStr(FInfoVolumeRecord.VolumeSize)]);
  case FInfoVolumeRecord.FileSystemID of
    1 : FColorPanel.Color   := clAqua;    // FAT
    2 : FColorPanel.Color   := clGreen;   // FAT32
    3 : FColorPanel.Color   := clBlue;    // NTFS
    4 : FColorPanel.Color   := clFuchsia; // exFAT
    5 : FColorPanel.Color   := clBlack;   // UNKNOWN
  end;
  FColorPanel.Refresh;
end;

Wer auch den Hersteller haben möchte, passt die Procedure ShowDeviceData so an:

Delphi-Quellcode:

...
    lbManufacturer.Caption  := Copy(FDeviceInfoRecord.IdentRecord.ModelNumber, 1, POS(' ', FDeviceInfoRecord.IdentRecord.ModelNumber) -1);
...

Vorausgesetzt, dass Label lbManufacturer existiert.

Die Unit comHelpHDD hat sich geändert:

Delphi-Quellcode:

unit comHelpHDD;

interface

uses
  Windows, Classes, jwaWinIOCTL;

type
  TParatitionInfoRecord = record
    DriveLetter         : Char;
    PartitionStyle      : Byte;
    PartitionLength     : Int64;
    PartitionNumber     : DWORD;
    StartingOffset      : Int64;
  end;

  PVolumenInfoEntry = ^TVolumenInfoEntry;
  TVolumenInfoEntry = record
    DriveLetter         : Char;
    FileSystemID        : Byte;
    FileSystem          : String;
    VolumeName          : String;
    FreeSpace           : Int64;
    VolumeSize          : Int64;
  end;

  PVolumeInfoRecord    = ^TVolumeInfoRecord;
  TVolumeInfoRecord    = Array of TVolumenInfoEntry;

  PDriveLayoutRecord    = ^TDriveLayoutRecord;
  TDriveLayoutRecord    = record
    PartitionStyle      : DWORD;
    PartitionCount      : DWORD;
    Union               : record
      case Integer of
        0: (Mbr: DRIVE_LAYOUT_INFORMATION_MBR);
        1: (Gpt: DRIVE_LAYOUT_INFORMATION_GPT);
      end;
    PartitionEntry      : array [0..3] of TParatitionInfoRecord;
  end;

  PDeviceIdentRecord    = ^TDeviceIdentRecord;
  TDeviceIdentRecord    = record
    SerialNumber        : String;
    FirmwareRev         : String;
    ModelNumber         : String;
    InterfaceType       : String;
  end;


  TSizeFormat           = (sfMB, sfGB, sfTB);

  PDeviceInfoRecord     = ^TDeviceInfoRecord;
  TDeviceInfoRecord     = record
    DeviceID            : Byte;
    DeviceLength        : Int64;
    IdentRecord         : TDeviceIdentRecord;
    LayoutRecord        : TDriveLayoutRecord;
    InfoRecord          : TVolumeInfoRecord;
  end;


function  SizeFormatStr(DeviceSize : Int64; GiBs : Boolean = true) : String;
function  LBASizeToGB(DeviceSize : Int64; GiBs : Boolean = true) : Integer;
function  MeasureDeviceInfoRecord(aDeviceID : Byte) : PDeviceInfoRecord;

implementation

uses
  SysUtils, ActiveX, Variants, WbemScript;

type
  TDriveInfoObject     = class(TObject)
  private
    FDriveLetter       : Char;
    FDeviceID          : Byte;
    FPartitionNumber   : DWORD;
  public
    constructor Create(aDrive : Char; aDeviceID: Byte; aPartitionNumber : DWORD);
    property DriveLetter      : Char              read FDriveLetter;
    property DeviceID         : Byte              read FDeviceID;
    property PartitionNumber  : DWORD             read FPartitionNumber;
  end;

{**************************** TDriveInfoObject *******************************}

constructor TDriveInfoObject.Create(aDrive : Char; aDeviceID: Byte; aPartitionNumber : DWORD);
begin
  FDriveLetter      := aDrive;
  FDeviceID         := aDeviceID;
  FPartitionNumber  := aPartitionNumber;
end;

{**************************** Helpers *****************************************}

function    LBASizeToGB(DeviceSize : Int64; GiBs : Boolean = true) : Integer;
var
  I, J : Integer;
begin
  if GiBs then J := 1000000000
          else J := 1073741824;
  if DeviceSize = 0 then I := 0
  else
  begin
    I := Round(DeviceSize / J);
    while (I <= 1) do
    begin
      if GiBs then J := J div 1000
              else J := J div 1024;
      I := Round(DeviceSize / J);
    end;
  end;
  Result := I;
end;

function  SizeFormatStr(DeviceSize : Int64; GiBs : Boolean = true) : String;
var
  J : Int64;
begin
  if GiBs then J := 1000000000
          else J := 1073741824;
  if DeviceSize < J then Result := 'MB'
  else
  if DeviceSize > J then
  begin
    if GiBs then J := J * 1000
            else J := J * 1024;
    if DeviceSize >= J then Result := 'TB'
                       else Result := 'GB';
  end;
end;

function  FindDeviceByDriveLetter(DeviceID : Byte; aDetails : Boolean) : TStringList;
var
  I               : Integer;
  hVolume         : THandle;
  SDN             : STORAGE_DEVICE_NUMBER;
  lpBytesReturned : Cardinal;
begin
  Result := TStringList.Create;
  try
    for I := Ord('C') to Ord('Z') do
    begin
      hVolume := CreateFile(PChar(Format('\\.\%s:', [Char(I)])),
                          GENERIC_READ,
                          FILE_SHARE_READ or FILE_SHARE_WRITE,
                          nil,
                          OPEN_EXISTING, 0, 0);
      if hVolume <> INVALID_HANDLE_VALUE then
      begin
        if DeviceIOControl(hVolume,
                           IOCTL_STORAGE_GET_DEVICE_NUMBER,
                           nil,
                           0,
                           @SDN,
                           SizeOf(SDN),
                           lpBytesReturned,
                           nil) then
        if SDN.DeviceType = FILE_DEVICE_DISK then
          if DeviceID = SDN.DeviceNumber then
            if aDetails then
              Result.AddObject(IntToStr(SDN.PartitionNumber), TDriveInfoObject.Create(Char(I), SDN.DeviceNumber, SDN.PartitionNumber))
            else
              Result.Add(Char(I) + ':\');
      end;
    end;
  except
    Result.Free;
  end;
end;

function  DeviceExists(aDeviceName : String) : Boolean;
var
  DeviceHandle    : THandle;
  {$IFDEF VER200}
  DeviceName      : PWideChar;
  {$ELSE}
  DeviceName      : PChar;
  {$ENDIF}
  GLI             : GET_LENGTH_INFORMATION;
  lpBytesReturned : Cardinal;
begin
  DeviceName   := StrAlloc(MAX_PATH);
  StrPCopy(DeviceName, aDeviceName);
  DeviceHandle := CreateFile(DeviceName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  StrDispose(DeviceName);
  Result       := DeviceHandle <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    if DeviceIOControl(DeviceHandle, IOCTL_DISK_GET_LENGTH_INFO, nil, 0, @GLI, SizeOf(GLI), lpBytesReturned, nil) then
      Result := GLI.Length.QuadPart > 0
    else
      Result := false;
    CloseHandle(DeviceHandle);
  end;
end;

function  DeviceSize(aDeviceName : String) : UInt64;
var
  DeviceHandle    : THandle;
  {$IFDEF VER200}
  DeviceName      : PWideChar;
  {$ELSE}
  DeviceName      : PChar;
  {$ENDIF}
  GLI             : GET_LENGTH_INFORMATION;
  lpBytesReturned : Cardinal;
begin
  Result := 0;
  DeviceName   := StrAlloc(MAX_PATH);
  StrPCopy(DeviceName, aDeviceName);
  DeviceHandle := CreateFile(DeviceName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  StrDispose(DeviceName);
  if DeviceHandle <> INVALID_HANDLE_VALUE then
  begin
    if DeviceIOControl(DeviceHandle, IOCTL_DISK_GET_LENGTH_INFO, nil, 0, @GLI, SizeOf(GLI), lpBytesReturned, nil) then
      Result := GLI.Length.QuadPart;
    CloseHandle(DeviceHandle);
  end;
end;

function  GetDevicePartitionInfo(aDeviceName : String; var LayoutRecord: TDriveLayoutRecord) : Boolean;
var
  DeviceHandle    : THandle;
  {$IFDEF VER200}
  DeviceName      : PWideChar;
  {$ELSE}
  DeviceName      : PChar;
  {$ENDIF}
  pDLIE           : PDRIVE_LAYOUT_INFORMATION_EX;
  dwSize          : DWORD;
  lpBytesReturned : Cardinal;
  I               : Integer;
begin
  Result        := False;
  GetMem(DeviceName, MAX_PATH);
  StrPCopy(DeviceName, aDeviceName);
  DeviceHandle:= CreateFile(DeviceName,
                            GENERIC_READ, // or GENERIC_WRITE,
                            FILE_SHARE_READ or FILE_SHARE_WRITE,
                            nil, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0);
  if DeviceHandle <> INVALID_HANDLE_VALUE then
  begin
    try

      dwSize := SizeOf(_DRIVE_LAYOUT_INFORMATION_EX) + SizeOf(_PARTITION_INFORMATION_EX) * 31;
      GetMem(pDLIE, dwSize);
      FillChar(pDLIE^, dwSize, 0);
      Result := DeviceIOControl(DeviceHandle, IOCTL_DISK_GET_DRIVE_LAYOUT_EX, nil, 0,
                         pDLIE, dwSize, lpBytesReturned, nil);
      if Result then
      begin
        LayoutRecord.PartitionStyle := pDLIE^.PartitionStyle;
        LayoutRecord.PartitionCount := 0;
//        LayoutRecord.Union          := pDLIE^.Union;
        for I := 0 to pDLIE^.PartitionCount - 1 do
          if pDLIE^.PartitionEntry[I].PartitionLength.QuadPart > 0 then
          begin
            LayoutRecord.PartitionEntry[I].PartitionStyle := DWORD(pDLIE^.PartitionEntry[I].PartitionStyle);
            LayoutRecord.PartitionEntry[I].PartitionLength:= pDLIE^.PartitionEntry[I].PartitionLength.QuadPart;
            LayoutRecord.PartitionEntry[I].PartitionNumber:= pDLIE^.PartitionEntry[I].PartitionNumber;
            LayoutRecord.PartitionEntry[I].StartingOffset := pDLIE^.PartitionEntry[I].StartingOffset.QuadPart;
            Inc(LayoutRecord.PartitionCount);
          end;
      end;

      FreeMem(pDLIE);
    finally
      CloseHandle(DeviceHandle);
    end;
  end;
  FreeMem(DeviceName);
end;

function GetWMIDeviceInfo(aID : Byte; aWQLStr : String; var Data) : Boolean;
var
  wmiLocator    : ISWbemLocator;
  wmiServices   : ISWbemServices;
  wmiObjectSet  : ISWbemObjectSet;
  wmiObject     : ISWbemObject;
  propSet       : ISWbemPropertySet;
  wmiProp       : ISWbemProperty;
  propEnum,
  Enum          : IEnumVariant;
  ovVar         : OleVariant;
  lwValue       : LongWord;
  sValue,
  sName         : String;
  i             : integer;
begin
  CoInitialize(nil);
  wmiLocator    := CoSWbemLocator.Create;
  try
    wmiServices := wmiLocator.ConnectServer('.', 'root\CIMV2', '', '','', '', 0, nil);
    try
      if Assigned(wmiServices) then
      begin
        wmiObjectSet := wmiServices.ExecQuery(aWQLStr, 'WQL', wbemFlagReturnWhenComplete, nil);
        if wmiObjectSet.Count > 0 then
        begin
          Enum := (wmiObjectSet._NewEnum) as IEnumVariant;
          if ((Enum <> nil) and (Enum.Next (1, ovVar, lwValue) = S_OK)) then
          begin
            wmiObject := IUnknown(ovVar) as SWBemObject;
            propSet   := wmiObject.Properties_;
            propEnum  := (propSet._NewEnum) as IEnumVariant;
            while (propEnum.Next (1, ovVar, lwValue) = S_OK) do
            begin
              wmiProp := IUnknown(ovVar) as SWBemProperty;
              sName   :=  AnsiLowercase(wmiProp.Name);

              svalue := #0;
              if VarIsNull(wmiProp.Get_Value) then
                sValue := #0
              else
              begin
                case wmiProp.CIMType of
                    wbemCimtypeSint8,
                    wbemCimtypeUint8,
                    wbemCimtypeSint16,
                    wbemCimtypeUint16,
                    wbemCimtypeSint32,
                    wbemCimtypeUint32,
                    wbemCimtypeSint64     : if VarIsArray(wmiProp.Get_Value) then
                                            begin
                                              for I := 0 to VarArrayHighBound(wmiProp.Get_Value, 1) do
                                              begin
                                                if I > 0 then sValue := sValue + '|' ;
                                                sValue := sValue + IntToStr(wmiProp.Get_Value[I]) ;
                                              end ;
                                            end
                                            else
                                            sValue := IntToStr(wmiProp.Get_Value);
                     wbemCimtypeReal32,
                     wbemCimtypeReal64    : sValue := FloatToStr (wmiProp.Get_Value);
                     wbemCimtypeBoolean   : if wmiProp.Get_Value then svalue := 'True' else svalue := 'False';
                     wbemCimtypeString,
                     wbemCimtypeUint64    : if VarIsArray(wmiProp.Get_Value) then
                                            begin
                                                for I := 0 to VarArrayHighBound (wmiProp.Get_Value, 1) do
                                                begin
                                                    if I > 0 then svalue := svalue + '|' ;
                                                    sValue := sValue + wmiProp.Get_Value [I] ;
                                                end ;
                                            end
                                            else
                                                sValue := wmiProp.Get_Value;
                     wbemCimtypeDatetime  : sValue := wmiProp.Get_Value;
                     wbemCimtypeReference : begin
                                              sValue := wmiProp.Get_Value;
                                            end;
                end;
              end;
              case aID of
               0 : begin
                     if sName = 'serialnumber' then     TDeviceIdentRecord(Data).SerialNumber  := TrimLeft(TrimRight(sValue));
                     if sName = 'firmwarerevision' then TDeviceIdentRecord(Data).FirmwareRev   := TrimLeft(TrimRight(sValue));
                     if sName = 'model' then      TDeviceIdentRecord(Data).ModelNumber   := TrimLeft(TrimRight(sValue));
                     if sName = 'interfacetype' then    TDeviceIdentRecord(Data).InterfaceType := TrimLeft(TrimRight(sValue));
                   end;
               1 : begin
                     if sName = 'volumename' then TVolumenInfoEntry(Data).VolumeName  := TrimLeft(TrimRight(sValue));
                     if sName = 'filesystem' then
                     begin
                       TVolumenInfoEntry(Data).FileSystem  := TrimLeft(TrimRight(sValue));
                       if TVolumenInfoEntry(Data).FileSystem = 'FAT' then TVolumenInfoEntry(Data).FileSystemID   := 1
                       else
                       if TVolumenInfoEntry(Data).FileSystem = 'FAT32' then TVolumenInfoEntry(Data).FileSystemID := 2
                       else
                       if TVolumenInfoEntry(Data).FileSystem = 'NTFS' then TVolumenInfoEntry(Data).FileSystemID  := 3
                       else
                       if TVolumenInfoEntry(Data).FileSystem = 'exFAT' then TVolumenInfoEntry(Data).FileSystemID  := 4
                       else
                       begin
                        TVolumenInfoEntry(Data).FileSystemID  := 4;
                        TVolumenInfoEntry(Data).FileSystem    := 'UNKNOWN';
                       end;
                     end;
                     if sName = 'freespace'  then TVolumenInfoEntry(Data).FreeSpace   := StrToInt64(TrimLeft(TrimRight(sValue)));
                     if sName = 'size'       then TVolumenInfoEntry(Data).VolumeSize  := StrToInt64(TrimLeft(TrimRight(sValue)));
                   end;
              end;
            end;
          end;
        end;
      end;
    finally
    end;
  finally
    wmiLocator := nil;
    CoUninitialize;
    case aID of
      0 : with TDeviceIdentRecord(Data) do Result := (SerialNumber <> '') or (FirmwareRev <> '') or (ModelNumber <> '') or (InterfaceType <> '');
      1 : with TVolumenInfoEntry(Data) do Result := (VolumeName <> '') or (FileSystem <> '');
    end;
  end;
end;

function  MeasureDeviceInfoRecord(aDeviceID : Byte) : PDeviceInfoRecord;
var
  DN    : String;
  DL    : TStringList;
  WqlStr: String;
  Data  : TDeviceIdentRecord;
  DLR   : TDriveLayoutRecord;
  VIR   : TVolumeInfoRecord;
  I, J  : Integer;
begin
  DN := Format('\\.\PHYSICALDRIVE%d', [aDeviceID]);
  Result := New(PDeviceInfoRecord);
  with Result^ do
  begin
    DeviceID     := aDeviceID;
    if DeviceExists(DN) then
    begin
      DeviceLength := DeviceSize(DN);
      DL := FindDeviceByDriveLetter(DeviceID, true);
      try
        if GetDevicePartitionInfo(DN, DLR) then
        begin
          SetLength(VIR, DLR.PartitionCount);
          for I := 0 to DLR.PartitionCount -1 do
          begin
            J := DL.IndexOf(IntToStr(DLR.PartitionEntry[I].PartitionNumber));
            if J > -1 then
            begin
              DLR.PartitionEntry[I].DriveLetter := TDriveInfoObject(DL.Objects[J]).DriveLetter;
              VIR[I].DriveLetter                := DLR.PartitionEntry[I].DriveLetter;
            end;
          end;
          LayoutRecord  := DLR;

          WqlStr := Format('SELECT * FROM Win32_DiskDrive WHERE DeviceID = ''\\\\.\\PHYSICALDRIVE%d''',[aDeviceID]);
          if GetWMIDeviceInfo(0, WqlStr, Data) then IdentRecord := Data;

          for I := 0 to Length(VIR) -1 do
            if VIR[I].DriveLetter <> '' then
            begin
              WqlStr := Format('SELECT DeviceID, FileSystem, FreeSpace, Size, VolumeName From win32_LogicalDisk WHERE DeviceID = ''%s:''', [VIR[I].DriveLetter]);
              GetWMIDeviceInfo(1, WqlStr, VIR[I]);
            end;
          InfoRecord := VIR;
        end;
      finally
        DL.Free;
      end;
    end;
  end;
end;

end.

VG