首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
您现在的位置: 程式碼之家 >> 編程語言 >  >> 更多程式語言 >> Delphi

Delphi 讀取磁碟資訊完整工具箱:序列號、就緒狀態、磁碟機類型、剩餘空間與檔案系統偵測

     編輯:Delphi

前言

Delphi 透過 Windows API (GetVolumeInformation、GetLogicalDrives、GetDiskFreeSpaceEx) 可完整掌握系統磁碟機資訊。本文整理四大核心功能的實用函數庫,涵蓋序列號讀取、媒體就緒檢查、磁碟機列舉與空間統計。

1. 讀取磁碟區序列號

uses Windows, SysUtils;

function GetDiskSerial(DriveChar: Char): string;
var
  SerialNum: DWORD;
  MaxCompLen, FileSysFlags: DWORD;
  VolNameBuf, FSNameBuf: array[0..255] of Char;
begin
  Result := '';
  // GetVolumeInformation 需以 'C:\' 格式傳入根目錄
  if GetVolumeInformation(PChar(DriveChar + ':\'), 
       VolNameBuf, SizeOf(VolNameBuf), 
       @SerialNum, MaxCompLen, FileSysFlags, 
       FSNameBuf, SizeOf(FSNameBuf)) then
    Result := IntToStr(SerialNum)
  else
    RaiseLastOSError;
end;

// 使用
ShowMessage('C: 序列號: ' + GetDiskSerial('C'));

2. 檢查磁碟機就緒狀態 (避免「裝置未就緒」彈窗)

function IsDriveReady(DriveChar: Char): Boolean;
var
  OldErrorMode: UINT;
  RootPath: string;
  MaxCompLen, FileSysFlags: DWORD;
begin
  RootPath := DriveChar + ':\';
  // 關鍵:SEM_FAILCRITICALERRORS 防止系統彈出「無磁碟」對話框
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    Result := GetVolumeInformation(PChar(RootPath), nil, 0, nil, 
              MaxCompLen, FileSysFlags, nil, 0);
  finally
    SetErrorMode(OldErrorMode);
  end;
end;

// 使用
if IsDriveReady('A') then
  ShowMessage('軟碟機有媒體')
else
  ShowMessage('軟碟機無媒體或未就緒');

3. 詳細磁碟機狀態偵測 (無媒體/未格式化/空白/有檔案)

type
  TDriveMediaState = (dsNoMedia, dsUnformatted, dsEmpty, dsHasFiles);

function GetDriveMediaState(DriveChar: Char): TDriveMediaState;
var
  SR: TSearchRec;
  OldErrorMode: UINT;
  Mask: string;
  FindResult: Integer;
begin
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    Mask := DriveChar + ':\*.*';
    {$I-}
    FindResult := FindFirst(Mask, faAnyFile, SR);
    {$I+}
    FindClose(SR);
    
    case FindResult of
      0: Result := dsHasFiles;      // 找到檔案
      18: Result := dsEmpty;        // ERROR_NO_MORE_FILES = 空白磁碟
      21, 3: Result := dsNoMedia;   // ERROR_NOT_READY / ERROR_WRITE_PROTECT
    else
      Result := dsUnformatted;      // 其他錯誤視為未格式化
    end;
  finally
    SetErrorMode(OldErrorMode);
  end;
end;

4. 列舉所有磁碟機並計算空間 (支援 >2TB)

uses Windows, SysUtils, StrUtils;

procedure ListAllDrivesWithSpace(Strings: TStrings);
var
  DriveBits: DWORD;
  DriveChar: Char;
  DriveType: UINT;
  FreeBytes, TotalBytes, TotalFreeBytes: ULARGE_INTEGER;
  DriveRoot: string;
begin
  Strings.BeginUpdate;
  try
    DriveBits := GetLogicalDrives; // 位元圖:bit 0=A:, bit 1=B: ...
    for DriveChar := 'A' to 'Z' do
    begin
      if (DriveBits and (1 shl (Ord(DriveChar) - Ord('A')))) = 0 then
        Continue; // 磁碟機不存在
      
      DriveRoot := DriveChar + ':\';
      DriveType := GetDriveType(PChar(DriveRoot));
      
      // 過濾類型 (可選)
      if DriveType in [DRIVE_CDROM, DRIVE_REMOVABLE] then
        Continue; // 略過光碟/可移除 (視需求)
      
      // 使用 GetDiskFreeSpaceEx 支援 64-bit 空間
      if GetDiskFreeSpaceEx(PChar(DriveRoot), 
           FreeBytes, TotalBytes, @TotalFreeBytes) then
      begin
        Strings.Add(Format('%s: 總容量 %.2f GB, 可用 %.2f GB, 類型 %s', [
          DriveRoot,
          TotalBytes.QuadPart / (1024*1024*1024),
          FreeBytes.QuadPart / (1024*1024*1024),
          DriveTypeToStr(DriveType)
        ]));
      end
      else
        Strings.Add(DriveRoot + ': 無法讀取空間資訊 (錯誤 ' + IntToStr(GetLastError) + ')');
    end;
  finally
    Strings.EndUpdate;
  end;
end;

function DriveTypeToStr(DT: UINT): string;
begin
  case DT of
    DRIVE_UNKNOWN: Result := '未知';
    DRIVE_NO_ROOT_DIR: Result := '無根目錄';
    DRIVE_REMOVABLE: Result := '可移除';
    DRIVE_FIXED: Result := '固定';
    DRIVE_REMOTE: Result := '網路';
    DRIVE_CDROM: Result := '光碟';
    DRIVE_RAMDISK: Result := 'RAM 磁碟';
  else Result := '其他(' + IntToStr(DT) + ')';
  end;
end;

5. 取得檔案系統名稱與旗標

procedure GetVolumeDetails(DriveChar: Char; out VolName, FSName: string; out Flags: DWORD);
var
  VolBuf, FSBuf: array[0..255] of Char;
  SerialNum, MaxCompLen: DWORD;
begin
  if GetVolumeInformation(PChar(DriveChar + ':\'), 
       VolBuf, SizeOf(VolBuf), @SerialNum, MaxCompLen, Flags, 
       FSBuf, SizeOf(FSBuf)) then
  begin
    VolName := VolBuf;
    FSName := FSBuf;
  end
  else
    RaiseLastOSError;
end;

// 旗標解讀 (FileSysFlags)
const
  FS_CASE_SENSITIVE       = $00000001; // 大小寫敏感
  FS_CASE_IS_PRESERVED    = $00000002; // 保留大小寫
  FS_UNICODE_STORED_ON_DISK = $00000004; // 支援 Unicode 檔名
  FS_PERSISTENT_ACLS      = $00000008; // ACL 權限
  FS_FILE_COMPRESSION     = $00000010; // 壓縮
  FS_VOL_IS_COMPRESSED    = $00000020; // 磁碟區壓縮 (NTFS)
  FS_SUPPORTS_ENCRYPTION  = $00000040; // EFS 加密
  FS_SUPPORTS_OBJECT_IDS  = $00000100; // 物件 ID
  FS_SUPPORTS_REPARSE_POINTS = $00000200; // 重新解析點 (符號連結)
  FS_SUPPORTS_SPARSE_FILES = $00000400; // 稀疏檔案
  FS_SUPPORTS_TRANSACTIONS = $00002000; // TxF 交易
  FS_SEQUENTIAL_WRITE_ONCE = $00004000; // 光碟寫入一次

整合範例:磁碟機資訊總覽視窗

procedure TForm1.BtnScanClick(Sender: TObject);
var
  DriveChar: Char;
  State: TDriveMediaState;
  VolName, FSName: string;
  Flags: DWORD;
begin
  Memo1.Clear;
  for DriveChar := 'A' to 'Z' do
  begin
    if IsDriveReady(DriveChar) then
    begin
      State := GetDriveMediaState(DriveChar);
      GetVolumeDetails(DriveChar, VolName, FSName, Flags);
      Memo1.Lines.Add(Format('%s: 卷標=%s, FS=%s, 狀態=%s, 序列號=%s, 旗標=%.8x', [
        DriveChar + ':',
        VolName, FSName,
        GetEnumName(TypeInfo(TDriveMediaState), Ord(State)),
        GetDiskSerial(DriveChar),
        Flags
      ]));
    end
    else
      Memo1.Lines.Add(DriveChar + ': 未就緒或不存在');
  end;
end;

結語

掌握 GetVolumeInformation、GetLogicalDrives、GetDiskFreeSpaceEx 三大 API,配合 SetErrorMode(SEM_FAILCRITICALERRORS) 抑制系統錯誤對話框,即可建構完整、健壯的磁碟資訊偵測模組。注意 64-bit 空間計算必須使用 ULARGE_INTEGER 或 Int64 避免溢位。

  1. 上一篇文章:
  2. 下一篇文章:
Copyright © 程式碼之家 All Rights Reserved