Partitionen grafisch anzeigen wie Windows Datenträgerverwaltung

[Guido Eisenbeis]

So, heute bin ich mal faul, :angel2: 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:

Zitat von Robin2k (Beitrag 1210954)

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. :wink: 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, :angel2: ... würde ich dich nicht aufhalten. :mrgreen:

[Guido Eisenbeis]

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

Hab die Hoffnung noch nicht aufgegeben. :-D

[Alter Mann]

Hallo,

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

VG

[Guido Eisenbeis]

Hallo Alter Mann,

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

[Alter Mann]

Nun gut, dann soll es so sein:wink:.

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:oops:.

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! :thumb: Sieht ja schonmal interessant aus. Werd ich mir über's Wochenende ansehen. Vielen Dank. :-D

[Alter Mann]

Moin, Moin

Keiner ist Perfekt:oops:, 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:wink:.

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

[Guido Eisenbeis]

Leider krieg ich die Jedi-Dingens-Kirschens nicht installiert (wg. Turbo Delphi). Ich habe jetzt zwar alle pas und inc in den Projektordner kopiert, die Delphi angemeckert hat, aber die Macht ist nicht mit mir. Das Programm startet zwar, aber es passiert nichts, außer bei einem Label: "Größe: 0 MB".

Trotzdem vielen Dank für das Update. Vielleicht kann ich ja noch was aus deinem Code rausziehen. :-D

Edit:

Ok, hab jetzt mit " DevIR := MeasureDeviceInfoRecord(1);" rumgespielt und bei einem eingesetzten Wert von 1 wird meine Festplatte 2 (von 3) eingelesen und angezeigt. Bei Wert 0 und 2 werden Exeptions geschmissen, bei 3 passiert garnichts. (Wäre auch logisch, wenn da die 4 Festplatte abgefragt wird, die ja nicht vorhanden ist.)

Mal sehen, vielleicht krieg ich ja noch was ins Laufen. :-)

[Alter Mann]

@Guido Eisenbeis

Die Unit jwaWinIOCTL ist nicht mehr erforderlich.

@all
Ich habe die ganze Sache ein wenig überarbeitet.
Festplatten die eine GPT haben werden nun auch unterstützt.

Die Funktion LBASizeToGB ist nun komplett neu, da die bisherige
bei meinem 1GB USB-Stick 1048GB angezeigt hatte:pale:.

Da ich per PN angemeckert wurde (Jim Panse) habe ich das ganze ein wenig
gründlicher getestet(Windows XP, Windows 7; Delphi 7, Delphi 2009).

Noch ein kleiner Hinweis, ohne WMI geht garnichts!

VG

[Guido Eisenbeis]

Zitat:

Zitat von Alter Mann (Beitrag 1212193)

Da ich per PN angemeckert wurde (Jim Panse) ...

Ui, anmeckern per PN ist nicht schön. Wir meckern öffentlich. :mrgreen:

OK, hab dein Update 3 getestet, läuft nun ohne dass ich Jedi-mäßig rumjonglieren muss. :thumb: So, ... da ich jetzt nicht auch meckern will, formulier ich mal ganz unschuldig: Könnte es sein, dass du keine HDD mit erweiterter Partition hast? :angel2: *pfeif*

Wie gesagt, stürzt das Programm bei mir ab, wenn ich Platte 1, oder Platte 3 abfrage. Die haben beide jeweils eine erweiterte Partition. Platte 2 funktioniert -> hat nur 2 primäre Partitionen.

Übrigens sehr angenehm, dass da nun Menüpunkte für die einzelnen Platten sind. :-D


Edit:

Und danke für das Einpacken ins Zip. Das Reinfummeln der einzelnen Änderungen war unbequem.

[Jim Panse]

Zitat:

Zitat von Alter Mann (Beitrag 1212193)

@Guido Eisenbeis

Die Unit jwaWinIOCTL ist nicht mehr erforderlich.

@all
Ich habe die ganze Sache ein wenig überarbeitet.
Festplatten die eine GPT haben werden nun auch unterstützt.

Die Funktion LBASizeToGB ist nun komplett neu, da die bisherige
bei meinem 1GB USB-Stick 1048GB angezeigt hatte:pale:.

Da ich per PN angemeckert wurde (Jim Panse) habe ich das ganze ein wenig
gründlicher getestet(Windows XP, Windows 7; Delphi 7, Delphi 2009).

Noch ein kleiner Hinweis, ohne WMI geht garnichts!

VG

"Alter Mann", den Sinn einer PN haben Sie offensichtlich nicht kapiert :evil:

== Daher hier der Text der PN an den alten Mann ===

Hallo "Alter Mann",

vielen Dank für den Sourcecode von DI!

Haben Sie die EXE schon mal auf einem anderen als Ihrem Rechner gestartet?

poDesigned mit Left bei 1308?

Ihre erste auf der DP hochgeladene Version von PartInfo.zip ermittelte bei mir immerhin noch 226 GB, die aktuelle Version von PartInfo.zip kommt auf 0 GB.

Allerdings zeigt DI absolut nichts weiter als diese sowieso falschen GB-Werte an.

Also keine bunten Panels - wie von Guido Eisenbeis gewünscht

Ätzenderweise kompiliert mein Delphi7 Ihren Quelltext nahezu problemlos und zeigt mir dann - zwei Meter rechts des Bildschirmrandes - Null GB an ;-(

Soweit meine aktuellen Erfahrungen mit Ihrem PartInfo.zip.

Natürlich schaut man einem geschenkten Gaul angeblich nicht ins Maul

MfG
"Jim Panse"

[Alter Mann]

@Guido Eisenbeis

Zitat:

Könnte es sein, dass du keine HDD mit erweiterter Partition hast?

:oops:

Wusste ich doch, da war noch was! :wink:.

@Jim Panse

Mal so nebenbei: Zum guten Umgangston gehört auch, das man etwas für sich behalten kann.
Ich habe deine PN als anmeckern

Zitat:

Ätzenderweise kompiliert mein Delphi7 Ihren Quelltext nahezu problemlos und zeigt mir dann - zwei Meter rechts des Bildschirmrandes - Null GB an ;-(

und Kritik empfunden und darauf reagiert.
Im Posting habe ich nur darauf hingewiesen. Und mal ganz ehrlich, ein

Zitat:

poDesigned mit Left bei 1308?

dürfte ja nun nicht wirklich die Hürde sein.

Im übrigen habe ich darauf hingewiesen das Verbesserungen noch notwendig sind.

VG

[Guido Eisenbeis]

Zitat:

Zitat von Jim Panse (Beitrag 1212196)

Natürlich schaut man einem geschenkten Gaul angeblich nicht ins Maul

Einen Moment lang hätte ich gerne etwas zum Umgangston geschrieben. Aber leider hab ich's dann scheinbar auch nicht kapiert. :mrgreen:

@Alter Mann

Klar sind in deinem Progrämmchen noch Fehler drin. Aber ich erwarte ja garnicht, dass alles schon mundgerecht geliefert wird. (Wär natürlich schon schön, :wink: ist aber bei diesem Thema eher unwahrscheinlich.) Aber es ist immerhin ein Anfang. Nörgler gibt es immer wieder. Pfeif drauf. Erst mal was besseres liefern.

Ich freue mich über den Ansatz, den mir dein Code vermittelt hat. Und dass du ihn zur Verfügung stellst. :thumb: Mal sehn, ob ich was draus machen kann.

[Luckie]

Hänge das ganze doch bitte als Zip-Datei an. Dann ist es etwas einfacher damit zu arbeiten.

[Alter Mann]

@Luckie

Wird gemacht, Entschuldigung.

@Guido Eisenbeis

Was die Erweiterten Partitionen angeht: Das wird etwas dauern, da ich gerade gesehen habe das dazu der Code doch 'nicht unerheblich' umgebaut werden muss.

@All

Hinweis: Erweiterten Partitionen werden zur Zeit nicht unterstützt.

[Alter Mann]

Hallo,

nun sollte es auch mit erweiterten Partitionen klappen.
Aber auch hier gilt: es gibt immer etwas zu verbessern:wink:.

VG

[Alter Mann]

Hi,

bitte in procedure TPartitionMapPanel.ShowPartitionData;folgende Änderung vornehmen:

Delphi-Quellcode:

    with TPartitionInfoPanel.Create(PIPOwner) do
    begin
      Width       := Round(FDriveLayoutRecord.PartitionEntry[I].PartitionLength / RF);

      if not IsEx then
      begin
        Left        := 2 + Round(FDriveLayoutRecord.PartitionEntry[I].StartingOffset  / RF);
        Top         :=  2;
        Height      := 75;
        if I = FDriveLayoutRecord.PartitionCount - 1 then Width := Width - 3;
      end
      else
      begin
        Left        := 4 + Round(FDriveLayoutRecord.PartitionEntry[I].StartingOffset  / RF);
        Top         :=  5;
        Height      := 68;
        if I = FDriveLayoutRecord.PartitionCount - 1 then Width := Width - 5;
      end;
      IsChild       := IsEx;
      InfoID        := I;
      Name          := Format('PartitionInfoPanel%d', [I]);
      OnCreateEvent := CreatePartitionPanel;
      Parent        := Self;
      Caption       := '';
    end;

Sollte nur eine Partition vorhanden sein, stimmt die Weite nicht.

Schönes Wochenende

[Guido Eisenbeis]

Hallo Alter Mann,

vielen Dank für die neue Version. Ich hab sie mal PartInfo-4a genannt. Bei einem Kurztest sah das schon mal gut aus. :thumb:

Falls du jetzt Langeweile hast :wink: kannst du dir mal das Partitionierungs-Beispiel im Anhangs-Bild ansehen. Wenn du das noch hinkriegst, bist du der Held. :thumb:

Ansonsten: Gute Arbeit!

[hathor]

Hast Du wirklich so eine chaotische Platte?
Was für eine Platzverschwendung (!!!) für diese zerstückelte Verwaltung!