Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Windows API / MS.NET Framework API (https://www.delphipraxis.net/20-library-windows-api-ms-net-framework-api/)
-   -   Delphi Laufwerksinformationen (https://www.delphipraxis.net/8767-laufwerksinformationen.html)

sakura 11. Sep 2003 15:28


Laufwerksinformationen
 
Liste der Anhänge anzeigen (Anzahl: 1)
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.

...:cat:...

Christian Seehase 11. Sep 2003 15:45

Re: Laufwerksinformationen
 
Moin sakura,

den Kommentar im PSDK zu GetDiskFreeSpace hast Du aber schon gelesen ;-)

Zitat:

Zitat von PSDK - GetDiskFreeSpace
The GetDiskFreeSpace function cannot report volume sizes that are greater than 2 GB. To ensure that your application works with large capacity hard drives, use the GetDiskFreeSpaceEx function.

Das gemeine ist, dass die Funktion teilweise richtige Daten liefert.
Bei mir stimmt z.b. die Angabe TotalNumberOfCluster, aber NumberOfFreeClusters wird um 224 zu klein zurückgegeben.

Besser wäre es wahrscheinlich mittels GetDiskFreeSpaceEx die Byteangaben zu ermitteln und mit Hilfe von GetDiskFreeSpace die Daten für die Clustergrösse, um daraus dann auf die korrekten Werte zu kommen.

Ich probier's mal aus.

Christian Seehase 11. Sep 2003 16:30

Re: Laufwerksinformationen
 
Moin sakura,

so, jetzt hab' ich das mal ausprobiert....
... und kriege die Krise

:gruebel: :pale:

es tritt genau der gleiche Fehler auf :shock:

Delphi-Quellcode:
var
    dwDummy1                 : Cardinal;
    dwDummy2                 : Cardinal;
    FClusterSize           : Cardinal;
    FBytesPerSector        : Cardinal;
    FNumberOfFreeClusters  : Cardinal;
    FNumberOfUsedClusters  : Cardinal;
    FSectorsPerCluster     : Cardinal;
    FTotalNumberOfClusters : Cardinal;

    FFreeBytesAvailable    : int64;
    FTotalNumberOfBytes    : int64;
    FTotalNumberOfFreeBytes : ULARGE_INTEGER;

begin
  GetDiskFreeSpace('c:\', FSectorsPerCluster, FBytesPerSector, dwDummy1,dwDummy2);
  FClusterSize := FBytesPerSector * FSectorsPerCluster;
  GetDiskFreeSpaceEx('c:\',FFreeBytesAvailable,FTotalNumberOfBytes,@FTotalNumberOfFreeBytes);
  FTotalNumberOfClusters := FTotalNumberOfBytes div FClusterSize;
  FNumberOfFreeClusters := FFreeBytesAvailable div FClusterSize;
  FNumberOfUsedClusters := FTotalNumberOfClusters - FNumberOfFreeClusters;
  ShowMessage(IntToStr(FTotalNumberOfClusters)+#13#10
    +IntToStr(FNumberOfFreeClusters)+IntToStr(dwDummy1)+#13#10
    +IntToStr(FNumberOfUsedClusters));
end;
[edit=Chakotay1308]Zu lange Zeile gekürzt. Mfg, Chakotay1308[/edit]


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:09 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz