Thema: Delphi Laufwerksinformationen

Einzelnen Beitrag anzeigen

Benutzerbild von sakura
sakura

Registriert seit: 10. Jun 2002
Ort: München
11.412 Beiträge
 
Delphi 11 Alexandria
 
#1

Laufwerksinformationen

  Alt 11. Sep 2003, 15:28
Da gerade die persönliche Anfrage kam, wie man einige Grundinformationen zu Laufwerken bekommt und diese Frage den meisten nicht zum ersten Mal unterkommt, hier eine simple Klasse mit einigen HDD-Infos.

Delphi-Quellcode:
unit uDriveInfo;

interface

uses
  Windows, Classes, Contnrs;

type
  TClusterState = (csUsed, csBlocked, csMoving, csSelected, csConflict,
      csFragmented);
  TClusterStates = set of TClusterState;
  TClusterDatum = packed record
    ClusterState: TClusterStates;
    
  end;
  TClusterData = array of TClusterDatum;

  TDriveItem = class (TObject)
  private
    FBytesPerSector: Cardinal;
    FClusters: TClusterData;
    FDrive: string;
    FNumberOfFreeClusters: Cardinal;
    FNumberOfUsedClusters: Cardinal;
    FSectorsPerCluster: Cardinal;
    FTotalNumberOfClusters: Cardinal;
    function GetDriveName: string;
  public
    constructor Create(aDrive: string);
    destructor Destroy; override;
    property BytesPerSector: Cardinal read FBytesPerSector;
    property Clusters: TClusterData read FClusters;
    property Drive: string read FDrive;
    property DriveName: string read GetDriveName;
    property NumberOfFreeClusters: Cardinal read FNumberOfFreeClusters;
    property NumberOfUsedClusters: Cardinal read FNumberOfUsedClusters;
    property SectorsPerCluster: Cardinal read FSectorsPerCluster;
    property TotalNumberOfClusters: Cardinal read FTotalNumberOfClusters;
  end;
  
implementation

{ TDriveItem }

constructor TDriveItem.Create(aDrive: string);
begin
  inherited Create;
  FDrive := aDrive;
  GetDiskFreeSpace(@FDrive[1], FSectorsPerCluster, FBytesPerSector,
      FNumberOfFreeClusters, FTotalNumberOfClusters);
  FNumberOfUsedClusters := FTotalNumberOfClusters - FNumberOfFreeClusters;
  SetLength(FClusters, 0);
end;

destructor TDriveItem.Destroy;
begin
  inherited Destroy;
end;

function TDriveItem.GetDriveName: string;
var
  OldErrorMode: Integer;
  NotUsed, VolFlags: DWORD;
  Buf: array[0..MAX_PATH] of Char;
begin
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    GetVolumeInformation(PChar(Drive), Buf, SizeOf(Buf), nil, NotUsed, VolFlags,
        nil, 0);
    Result := Buf;
  finally
    SetErrorMode(OldErrorMode);
  end;
end;

end.
Anbei noch ein Beispiel zur Nutzung der Unit.

......
Angehängte Dateien
Dateityp: zip drive_info.zip (3,3 KB, 160x aufgerufen)
Daniel W.
Ich bin nicht zurück, ich tue nur so
  Mit Zitat antworten Zitat