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.

相关阅读 >>

Delphi 获得memo、richedit的光标位置

Delphi写一个utf8编码格式的文本文件

Delphi trim删除字符串首尾空格

Delphi调用阿里云的对象存储服务oss

Delphi 逐个分解后字符串加载到stringgrid1

Delphi sametext

Delphi xe 提示没有定义decimalseparator等的解决方法

Delphi 从网页里下载图片的程序

Delphi 随机字符3

Delphi 利用google api生成二维码图像

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...