Partitionen grafisch anzeigen wie Windows Datenträgerverwaltung

[Guido Eisenbeis]

So, heute bin ich mal faul, und suche einen fertigen Code zum Anzeigen aller Partitionen auf einer Festplatte. Also nicht nur die üblicherweise in Windows-Arbeitsplatz angezeigten Partitionen, sondern auch die, die keinen LW-Buchstaben haben, wie z. B. Linux-Partitionen, oder unformatierte Partitionen.

Eigentlich suche ich einen Code, oder ein Modul, mit dem das Ganze "grafisch" anzeigt wird (siehe Bild im Anhang). Da sollte dann so sein, wie das die Windows-Datenträgerverwaltung macht. Da gibts einmal die Liste im oberen Bereich, und einmal unten einen grafischen Bereich, der die Festplatten als rechteckigen Balken anzeigt, mit kleineren Kästchen für die einzelnen Partitionen darin, sowie farbige Markierungen für "Primär", "Erweitert" und "Logisch".

Um jetzt nicht ganz als fauler Nutznieser der Früchte fremder Arbeiten da zu stehen, kurz zu meiner Intention: Ich habe mich nun schon einige Tage in das Thema eingearbeitet und es scheint soweit machbar, aber viel Fleißarbeit muss da auf jeden Fall rein. Also keine Zauberei. Falls sich also schon jemand die Mühe gemacht hat, und das zur Verfügung stellen würde, müsste man das Rad ja nicht ein nochmal neu erfinden.

Ich habe auch verschiedenen Code wie z. B. von Lucky (GetLogicalDrives) und Sakura (LoadLogicalDrives) gefunden, die sich schon seit 2002 damit beschäftigt haben. Jedoch werden dabei nur die Partitonen mit Laufwerksbuchstaben berücksichtigt und es fehlt dann noch die grafische Darstellung.

Zusammengefasst suche ich ein Modul, das die grafische Darstellung der Partitionen einer Festplatte übernimmt. Es soll dann ungefähr so aussehen, wie auf dem Bild im Anhang.

(Grafisch ist hier nicht als Grafik zu verstehen. Das können auch einfach "nur ein paar Panel" sein, wie Robin2k im nächsten Posting schreibt.)

Edit: Das Bla bla durchgestrichen, das vom Eigentlichen ablenkt. Thread-Titel entsprechend geändert.

[Back2Code]

Das sind doch auch nur Panel? Grafische Anzeige wäre jetzt für mich z.B ein Tortendiagramm.

[mentaltec]

Hi,

es ist wirklich kein Hexenwerk, weil die entsprechenden Zauberworte sind hier zu finden :

http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

und hier

http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

mfg

(*und nein, ich hab nix Buntes fertig - ich bewege mich auf der Kommandozeile oder darunter*)

[Guido Eisenbeis]

@mentaltec

Tja, ja, ... ein Mensch redet, der andere versteht was ganz anderes. Ich habe da wohl in meinem ersten Post zuviel rumgeeiert. Deshalb versuch ich hier mal mich klarer auszudrücken:

Ich suche jemanden, der diese Arbeit schon gemacht hat, und sie jetzt netterweise mir und der Forum-Gemeinde zur Verfügung stellt. Also etwas fertiges. Ich hab ja meine Ansprüche schon auf das "grafische" Modul beschränkt, wie Robin2k so schön schreibt. Aber dennoch vielen Dank für deine Links zu den (wahrscheinlich sehr nützlichen) Funktionen.

Zitat von Robin2k:

Das sind doch auch nur Panel? Grafische Anzeige wäre jetzt für mich z.B ein Tortendiagramm.

Für die einen sind das nur Panel, für die anderen die langweiligste Arbeit der Welt. Ich stimme dir voll zu, ist nicht wirklich eine Grafik, aber du verstehst glaube ich was gemeint ist. Die Panels haben auch den Vorteil, dass das Anklicken einfacher realisiert werden kann. ... Falls du also Lust haben solltest, ein paar zur Laufzeit hinzuzufügende Panel mit ein wenig Verwaltungscode zu versehen, die die Beschriftungen und die Farbhervorhebungen erledigen, ... würde ich dich nicht aufhalten.

[Guido Eisenbeis]

Hat jemand eine grafische Oberfläche fertig, die er zur Verfügung stellen kann?

Hab die Hoffnung noch nicht aufgegeben.

[Alter Mann]

Hallo,

ich habe hier so etwas, allerdings ist eine gewisse Einarbeitung und eventuelle
Verbesserungen notwendig.

VG

[Guido Eisenbeis]

Hallo Alter Mann,

sieht doch schonmal vielversprechend aus. Kannst es gerne hochladen, oder mich per PN kontaktieren, würde mich freuen.

[Alter Mann]

Nun gut, dann soll es so sein.

Verwendung finden ausser den Standard-Units noch die Units jwaWinIoctl(JEDI) und
die WbemScript, welche nichts anderes ist, als die importierte Typlib
'C:\WINDOWS\System32\wbem\wbemdisp.TLB' von Microsoft.

Was geht (noch) nicht:

• Anzeigen von nicht partitionierten Bereichen
• Anzeigen der Seriennummer von Festplatten die an USB angeschlossen sind(WMI).
• Anzeigen der Partitionsdaten von GPT-Festplatten.

Was muss noch gemacht werden:

• Siehe: was geht nicht.
• Erkennen des Filesystems und zuweisen einer Farbe entsprechend den Partitionstypen.

Hinweis: Das ganze wurde mit Delphi 7 entwickelt und sollte sich auch mit den anderen (höheren) Versionen compilieren lassen.

Um den Überblick nicht zu verlieren, habe ich die ganze sache in zwei Units unterteilt.
Eine die den GUI-Teil übernimmt und eine andere zum ermitteln der Daten.

Zum Einsammeln der für die Anzeige relevanten Informationen dient die Unit comHelpHDD:

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;

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


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 <= 0) do
    begin
      if GiBs then J := J div 1000
              else J := J div 1024;
      I := Round(DeviceSize / J);
    end;
  end;
  Result := I;
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
                       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.

Sie stellt im Wesentlichen nur die beiden Funktonen:

Delphi-Quellcode:

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

bereit.

Den Code zu den Funktionen:

• function GetWMIDeviceInfo(aID : Byte; aWQLStr : String; var Data) : Boolean;
• function LBASizeToGB(DeviceSize : Int64; GiBs : Boolean = true) : Integer;

habe ich (hier?) gefunden und ist nicht auf meinem Mist gewachsen.

Für die Darstellung der so ermittelten Information dient die Unit comHDDInfoGui :

Delphi-Quellcode:

unit comHDDInfoGui;

interface

uses
  Windows, Classes, Controls, Contnrs, Forms, Buttons, Menus,
  StdCtrls, ExtCtrls, jwaWinIOCTL, comHelpHDD;

type
  TCreatePanelEvent     = procedure(Sender : TObject; Index, InfoID : Integer) of Object;

  TPartitionInfoPanel   =  class(TPanel)
  private
    FFirst              : Boolean;
    FIndex              : Integer;
    FInfoID             : Integer;
    FColorPanel         : TPanel;
    FDriveVolume        : TLabel;
    FFileSystem         : TLabel;
    FInfoVolumeRecord   : TVolumenInfoEntry;
    FOnCreateEvent      : TCreatePanelEvent;
    procedure SetIndex(Value : Integer);
    procedure SetInfoID(Value : Integer);
    procedure SetVolumenInfoRecord(Value : TVolumenInfoEntry);
  protected
    procedure   CreateWnd; override;
    procedure   DoCreateEvent;
    procedure   ShowDeviceData;
    property OnCreateEvent : TCreatePanelEvent read FOnCreateEvent write FOnCreateEvent;
  public
    constructor Create(aOwner : TComponent);  override;
    property Index : Integer read FIndex write SetIndex default -1;
    property InfoID : Integer read FInfoID write SetInfoID default -1;
    property VolumenInfo : TVolumenInfoEntry  write SetVolumenInfoRecord;
  end;

  TPartitionMapPanel    = class(TPanel)
  private
    FPartitionList      : TObjectList;
    FDriveLayoutRecord  : PDriveLayoutRecord;
    FDeviceLength       : UINT64;
    FVolumeInfoRecord   : PVolumeInfoRecord;
    procedure SetDeviceLength(Value : UINT64);
  protected
    function  HasLayoutData : Boolean;
    procedure CreatePartitionPanel(Sender : TObject; Index, InfoID : Integer);
  public
    constructor Create(aOwner : TComponent);  override;
    destructor  Destroy;                      override;
    procedure   ShowPartitionData;
    property DeviceLength : UINT64             write SetDeviceLength;
    property DriveLayout  : PDriveLayoutRecord write FDriveLayoutRecord;
    property VolumenInfo  : PVolumeInfoRecord  write FVolumeInfoRecord;
  end;

  TDeviceInfoPanel   = class(TPanel)
  private
    lbSerialNumber      : TLabel;
    lbSerialNumberInfo  : TLabel;
    lbFirmWare          : TLabel;
    lbFirmWareInfo      : TLabel;
    lbModelName         : TLabel;
    lbModelNameInfo     : TLabel;
    lbDeviceSize        : TLabel;
    lbDeviceSizeInfo    : TLabel;
    lbInterface         : TLabel;
    lbInterfaceInfo     : TLabel;
    FFirst              : Boolean;
    FMutexHandle        : THandle;
    FPartitionMapPanel  : TPartitionMapPanel;
    FDeviceInfoRecord   : PDeviceInfoRecord;
    procedure SetDeviceInfoRecord(Value : PDeviceInfoRecord);
    procedure SetMutexHandle(Value : THandle);
  protected
    procedure   CreateWnd; override;
  public
    constructor Create(aOwner     : TComponent); override;
    destructor  Destroy;                         override;

    procedure   ShowDeviceData;

    property    DeviceInfoRecord  : PDeviceInfoRecord read FDeviceInfoRecord  write SetDeviceInfoRecord;
    property    MutexHandle       : THandle           read FMutexHandle       write SetMutexHandle;
  end;

implementation

uses
  SysUtils, Dialogs, Graphics, Math;



{**************************** TDeviceInfoPanel ********************************}

constructor TDeviceInfoPanel.Create(aOwner     : TComponent);
begin
  inherited Create(aOwner);
  BevelInner          := bvRaised;
  BevelOuter          := bvLowered;
  Width               := 490;
  Height              := 125;
  lbSerialNumber      := nil;
  lbSerialNumberInfo  := nil;
  lbFirmWare          := nil;
  lbFirmWareInfo      := nil;
  lbModelName         := nil;
  lbModelNameInfo     := nil;
  lbDeviceSize        := nil;
  lbDeviceSizeInfo    := nil;
  lbInterface         := nil;
  lbInterfaceInfo     := nil;
  FFirst              := true;
  FDeviceInfoRecord   := nil;
end;

destructor  TDeviceInfoPanel.Destroy;
begin
  if Assigned(FDeviceInfoRecord) then Dispose(FDeviceInfoRecord);
  inherited Destroy;
end;

procedure   TDeviceInfoPanel.CreateWnd;
begin
  inherited CreateWnd;
  if FFirst then
  begin
    FFirst                      := false;
    if lbSerialNumber           = nil then
    begin
      lbSerialNumber            := TLabel.Create(Self);
      lbSerialNumber.Left       := 4;
      lbSerialNumber.Top        := 4;
      lbSerialNumber.Caption    := 'Seriennummer:';
      lbSerialNumber.Parent     := Self;
    end;
    if lbSerialNumberInfo       = nil then
    begin
      lbSerialNumberInfo        := TLabel.Create(Self);
      lbSerialNumberInfo.Left   := 80;
      lbSerialNumberInfo.Top    := 4;
      lbSerialNumberInfo.Parent := Self;
    end;
    if lbFirmWare               = nil then
    begin
      lbFirmWare                := TLabel.Create(Self);
      lbFirmWare.Left           := 240;
      lbFirmWare.Top            :=   4;
      lbFirmWare.Caption        := 'Firmware:';
      lbFirmWare.Parent         := Self;
    end;
    if lbFirmWareInfo           = nil then
    begin
      lbFirmWareInfo            := TLabel.Create(Self);
      lbFirmWareInfo.Left       := 290;
      lbFirmWareInfo.Top        :=   4;
      lbFirmWareInfo.Parent     := Self;
    end;
    if lbModelName              = nil then
    begin
      lbModelName               := TLabel.Create(Self);
      lbModelName.Left          := 4;
      lbModelName.Top           := 20;
      lbModelName.Caption       := 'Modell:';
      lbModelName.Parent        := Self;
    end;
    if lbModelNameInfo          = nil then
    begin
      lbModelNameInfo           := TLabel.Create(Self);
      lbModelNameInfo.Left      := 80;
      lbModelNameInfo.Top       := 20;
      lbModelNameInfo.Parent    := Self;
    end;
    if lbDeviceSize             = nil then
    begin
      lbDeviceSize              := TLabel.Create(Self);
      lbDeviceSize.Left         := 240;
      lbDeviceSize.Top          := 20;
      lbDeviceSize.Parent       := Self;
      lbDeviceSize.Caption      := 'Größe:';
    end;
    if lbDeviceSizeInfo         = nil then
    begin
      lbDeviceSizeInfo          := TLabel.Create(Self);
      lbDeviceSizeInfo.Left     := 290;
      lbDeviceSizeInfo.Top      := 20;
      lbDeviceSizeInfo.Parent   := Self;
    end;
    if lbInterface              = nil then
    begin
      lbInterface               := TLabel.Create(Self);
      lbInterface.Left          := 350;
      lbInterface.Top           :=  4;
      lbInterface.Parent        := Self;
      lbInterface.Caption       := 'Interface:';
    end;
    if lbInterfaceInfo          = nil then
    begin
      lbInterfaceInfo           := TLabel.Create(Self);
      lbInterfaceInfo.Left      := 400;
      lbInterfaceInfo.Top       :=  4;
      lbInterfaceInfo.Parent    := Self;
    end;
    if FPartitionMapPanel       = nil then
    begin
      FPartitionMapPanel        := TPartitionMapPanel.Create(Self);
      FPartitionMapPanel.Left   :=   5;
      FPartitionMapPanel.Top    :=  40;
      FPartitionMapPanel.Parent := Self;
    end;
  end;
end;

procedure   TDeviceInfoPanel.SetDeviceInfoRecord(Value : PDeviceInfoRecord);
begin
  if FDeviceInfoRecord <> Value then FDeviceInfoRecord := Value;
end;

procedure   TDeviceInfoPanel.SetMutexHandle(Value : THandle);
begin
  if FMutexHandle <> Value then FMutexHandle := Value;
end;

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
        Result := Result + CC;
    end;
  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;
    if POS(FDeviceInfoRecord.IdentRecord.InterfaceType, FDeviceInfoRecord.IdentRecord.ModelNumber) > 0 then
    lbModelNameInfo.Caption     := Copy(FDeviceInfoRecord.IdentRecord.ModelNumber, 1, POS(FDeviceInfoRecord.IdentRecord.InterfaceType, FDeviceInfoRecord.IdentRecord.ModelNumber) -1)
    else
    if POS('Device', FDeviceInfoRecord.IdentRecord.ModelNumber) > 0 then
    lbModelNameInfo.Caption     := FDeviceInfoRecord.IdentRecord.ModelNumber;
    lbDeviceSizeInfo.Caption    := Format('%d GB', [LBASizeToGB(FDeviceInfoRecord.DeviceLength)]);
    lbInterfaceInfo.Caption     := FDeviceInfoRecord.IdentRecord.InterfaceType;

    FPartitionMapPanel.ShowPartitionData;
  end;
end;

{**************************** TPartitionMapPanel ******************************}

constructor TPartitionMapPanel.Create(aOwner : TComponent);
begin
  inherited Create(aOwner);
  BevelInner          := bvRaised;
  BevelOuter          := bvLowered;
  Width               := 480;
  Height              :=  80;
  FDeviceLength       := 0;
  FPartitionList      := TObjectList.Create;
end;

destructor  TPartitionMapPanel.Destroy;
begin
  FPartitionList.Free;
  inherited Destroy;
end;

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

function    TPartitionMapPanel.HasLayoutData : Boolean;
begin
  Result := (FDriveLayoutRecord.PartitionCount > 0);
end;

procedure   TPartitionMapPanel.CreatePartitionPanel(Sender : TObject; Index, InfoID : Integer);
begin
  TPartitionInfoPanel(FPartitionList[Index]).VolumenInfo := FVolumeInfoRecord^[InfoID];
end;

procedure   TPartitionMapPanel.SetDeviceLength(Value : UINT64);
begin
  if FDeviceLength <> Value then FDeviceLength := Value;
end;


{************************ TPartitionInfoPanel *********************************}

constructor TPartitionInfoPanel.Create(aOwner : TComponent);
begin
  inherited Create(aOwner);
  BevelInner        := bvRaised;
  BevelOuter        := bvLowered;
  ParentBackground  := false;
  Color             := clWindow;
  FFirst            := True;
  FIndex            := -1;
  FInfoID           := -1;
  FColorPanel       := nil;
  FDriveVolume      := nil;
  FFileSystem       := nil;
  FillChar(FInfoVolumeRecord, SizeOf(TVolumeInfoRecord), 0);
end;

procedure   TPartitionInfoPanel.CreateWnd;
begin
  inherited CreateWnd;
  if FFirst then
  begin
    FFirst := false;

    if FColorPanel  = nil then
    begin
      FColorPanel                   := TPanel.Create(Self);
      FColorPanel.Align             := alTop;
      FColorPanel.Height            := 18;
      FColorPanel.ParentBackground  := false;
      FColorPanel.Parent            := Self;
    end;

    if FDriveVolume = nil then
    begin
      FDriveVolume            := TLabel.Create(Self);
      FDriveVolume.Left       := 5;
      FDriveVolume.Top        := 25;
      FDriveVolume.Font.Style := [fsBold];
      FDriveVolume.Parent     := Self;
    end;

    if FFileSystem  = nil then
    begin
      FFileSystem             := TLabel.Create(Self);
      FFileSystem.Left        := 5;
      FFileSystem.Top         := 45;
      FFileSystem.Parent      := Self;
    end;
    DoCreateEvent;
  end;
end;

procedure   TPartitionInfoPanel.DoCreateEvent;
begin
  if (Assigned(FOnCreateEvent) and (FIndex > -1) and (FinfoID > -1)) then FOnCreateEvent(Self, FIndex, FInfoID);
end;

procedure   TPartitionInfoPanel.SetIndex(Value : Integer);
begin
  if FIndex <> Value then FIndex := Value;
end;

procedure   TPartitionInfoPanel.SetInfoID(Value : Integer);
begin
  if FInfoID <> Value then FInfoID := Value;
end;

procedure   TPartitionInfoPanel.SetVolumenInfoRecord(Value : TVolumenInfoEntry);
begin
  with Value do
  begin
    FInfoVolumeRecord.DriveLetter  := DriveLetter;
    FInfoVolumeRecord.FileSystem   := FileSystem;
    FInfoVolumeRecord.VolumeName   := VolumeName;
    FInfoVolumeRecord.FileSystemID := FileSystemID;
    FInfoVolumeRecord.VolumeSize   := VolumeSize;
    ShowDeviceData;
  end;
end;

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

end.

Die Festplatte als solches wird mit Hilfe der Komponente TDeviceInfoPanel präsentiert.
Sie zeigt die Informationen zur Seriennummer, Modell, Firmware, Größe und dem Interface an.
Gleichzeitig dient sie als Container für die Komponente TPartitionMapPanel , die ihrerseits die
die einzelnen Panels ( TPartitionInfoPanel) für die Partitionen aufnimmt.

Wer das ganz nun testen möchte, erstellt eine neue Anwendung, bindet die beiden Units sowie ein Menü ein und vervollständigt den Code wie folgt:

Delphi-Quellcode:

unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Menus, ActnList,
  comHelpHDD, comHDDInfoGui;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    aHDDReadln: TAction;
    aDummy: TAction;
    aFileExit: TAction;
    mnuHDD: TMenuItem;
    aHDDView: TAction;
    Einlesen1: TMenuItem;
    N1: TMenuItem;
    Anzeigen1: TMenuItem;
    Beenden1: TMenuItem;
    StatusBar: TStatusBar;
    procedure aFileExitExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure aHDDReadlnExecute(Sender: TObject);
    procedure aHDDViewExecute(Sender: TObject);
  private
    { Private-Deklarationen }
    DIP   : TDeviceInfoPanel;
    DevIR : PDeviceInfoRecord;
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation


{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  DIP         := TDeviceInfoPanel.Create(Self);
  DIP.Left    := 10;
  DIP.Top     := 15;
  DIP.Parent  := Self;
end;

procedure TMainForm.aFileExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.aHDDReadlnExecute(Sender: TObject);
begin
  DevIR := MeasureDeviceInfoRecord(3);
end;

procedure TMainForm.aHDDViewExecute(Sender: TObject);
begin
  if DevIR <> nil then
  begin
    DIP.DeviceInfoRecord := DevIR;
    DIP.ShowDeviceData; 
  end;
end;

end.

Wichtig ist hier:

Delphi-Quellcode:

procedure TMainForm.aHDDReadlnExecute(Sender: TObject);
begin
  DevIR := MeasureDeviceInfoRecord(3); // <-- 3 = '\\.\physicaldrive3' !!!
end;

Wer also keine 3 Festplatten hat, muss die Zahl anpassen.

Das war es. Wenn Fragen sind warum das eine so und das andere so gemacht wurde, fragen.
Wer der Meinung ist, das eine oder andere könnte man besser machen, bitte melden.

Wünsche viel Spaß und ein (hoffentlich) schönes Wochenende.

[Guido Eisenbeis]

Cool! Sieht ja schonmal interessant aus. Werd ich mir über's Wochenende ansehen. Vielen Dank.

[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