Delphi中实现磁盘信息类(TDriveInfo)



driveinfo.pas
unit DriveInfo;

{ TODO: Validate driveName }
{ TODO: Implement RootDirectory }

interface

uses
  Classes, Windows, SysUtils;

type
  TDriveType = (
   dtUnknown,    // The type of drive is unknown.
   dtNoRootDirectory,  // The drive does not have a root directory.
   dtRemovable,    // The drive is a removable storage device, such as a floppy disk drive or a USB flash drive.
   dtFixed,    // The drive is a fixed disk.
   dtNetwork,    // The drive is a network drive.
   dtCDRom,    // The drive is an optical disc device, such as a CD or DVD-ROM.
   dtRam    // The drive is a RAM disk.
  );

  TDriveInfo = record
  type
   TDriveInfoDynArray = array of TDriveInfo;
  private
   fDriveName: string;
   fAvailableFreeSpace: Int64;
   fTotalSize: Int64;
   fTotalFreeSpace: Int64;
   fVolumeName: array[0..MAX_PATH] of Char;
   fFileSystemName: array[0..MAX_PATH] of Char;
   fSerialNumber: DWORD;
   fMaximumComponentLength: DWORD;
   fFileSystemFlags: DWORD;
   function GetAvailableFreeSpace: Int64;
   function GetDriveFormat: string;
   function GetDriveType: TDriveType;
   function GetDriveTypeString: string;
   function GetIsReady: Boolean;
//    function GetRootDirectory: string;
   function GetTotalFreeSpace: Int64;
   function GetTotalSize: Int64;
   function GetVolumeLabel: string;
   procedure SetVolumeLabel(const Value: string);
  private
   procedure CheckIsReady;
   procedure Loaded;
  public
   constructor Create(const driveName: string);
   class function GetDrives: TDriveInfoDynArray; static;
   property AvailableFreeSpace: Int64 read GetAvailableFreeSpace;
   property DriveFormat: string read GetDriveFormat;
   property DriveType: TDriveType read GetDriveType;
   property DriveTypeString: string read GetDriveTypeString;
   property IsReady: Boolean read GetIsReady;
   property Name: string read fDriveName;
//    property RootDirectory: string read GetRootDirectory;
   property TotalFreeSpace: Int64 read GetTotalFreeSpace;
   property TotalSize: Int64 read GetTotalSize;
   property VolumeLabel: string read GetVolumeLabel write SetVolumeLabel;
  end;

resourcestring
  SUnknownDriveDescription    = 'Unknown Drive';
  SNoRootDirectoryDescription = 'No Root Directory';
  SRemovableDescription    = 'Removable Drive';
  SFixedDescription    = 'Fixed Drive';
  SNetworkDescription    = 'Network Drive';
  SCDRomDescription    = 'CD-Rom Drive';
  SRamDescription    = 'Ram Drive';

const
  DriveTypeStrings: array[TDriveType] of string = (
   SUnknownDescription,    // The type of drive is unknown.
   SNoRootDirectoryDescription,  // The drive does not have a root directory.
   SRemovableDescription,    // The drive is a removable storage device, such as a floppy disk drive or a USB flash drive.
   SFixedDescription,    // The drive is a fixed disk.
   SNetworkDescription,    // The drive is a network drive.
   SCDRomDescription,    // The drive is an optical disc device, such as a CD or DVD-ROM.
   SRamDescription    // The drive is a RAM disk.
  );

implementation

constructor TDriveInfo.Create(const driveName: string);
begin
  fDriveName := IncludeTrailingPathDelimiter(UpperCase(driveName));
end;

class function TDriveInfo.GetDrives: TDriveInfoDynArray;
var
  drives: TStringDynArray;
  i: Integer;
begin
  drives := Environment.GetLogicalDrives;
  SetLength(Result, Length(drives));
  for i := 0 to High(drives) do
  begin
   Result[i] := TDriveInfo.Create(drives[i]);
  end;
end;

procedure TDriveInfo.CheckIsReady;
begin
  if not IsReady then
   raise EIOException.CreateResFmt(@SDriveNotReady, [fDriveName]);
end;

procedure TDriveInfo.Loaded;
begin
  CheckIsReady;
  Win32Check(SysUtils.GetDiskFreeSpaceEx(
   PChar(fDriveName),
   fAvailableFreeSpace,
   fTotalSize,
   @fTotalFreeSpace
  ));
  Win32Check(Windows.GetVolumeInformation(
   PChar(fDriveName),
   fVolumeName,
   Length(fVolumeName),
   @fSerialNumber,
   fMaximumComponentLength,
   fFileSystemFlags,
   fFileSystemName,
   Length(fFileSystemName)
  ));
end;

function TDriveInfo.GetAvailableFreeSpace: Int64;
begin
  Loaded;
  Result := fAvailableFreeSpace;
end;

function TDriveInfo.GetDriveFormat: string;
begin
  Loaded;
  Result := fFileSystemName;
end;

function TDriveInfo.GetDriveType: TDriveType;
var
  value: Cardinal;
begin
  value := Windows.GetDriveType(PChar(fDriveName));
  case value of
   DRIVE_NO_ROOT_DIR:  Result := dtNoRootDirectory;
   DRIVE_REMOVABLE:    Result := dtRemovable;
   DRIVE_FIXED:    Result := dtFixed;
   DRIVE_REMOTE:    Result := dtNetwork;
   DRIVE_CDROM:    Result := dtCDRom;
   DRIVE_RAMDISK:    Result := dtRam;
   else    Result := dtUnknown;  // DRIVE_UNKNOWN
  end;
end;

function TDriveInfo.GetDriveTypeString: string;
begin
  Result := DriveTypeStrings[Self.DriveType];
end;

function TDriveInfo.GetIsReady: Boolean;
begin
  Result := Length(fDriveName) > 0;
  Result := Result and (SysUtils.DiskSize(Ord(fDriveName[1]) - $40) > -1);
end;

function TDriveInfo.GetTotalFreeSpace: Int64;
begin
  Loaded;
  Result := fTotalFreeSpace;
end;

function TDriveInfo.GetTotalSize: Int64;
begin
  Loaded;
  Result := fTotalSize;
end;

function TDriveInfo.GetVolumeLabel: string;
begin
  Loaded;
  Result := fVolumeName;
end;

procedure TDriveInfo.SetVolumeLabel(const Value: string);
begin
  CheckIsReady;
  Win32Check(Windows.SetVolumeLabel(PChar(fDriveName), PChar(value)));
end;

end.

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678