Delphi 透過 Windows API (GetVolumeInformation、GetLogicalDrives、GetDiskFreeSpaceEx) 可完整掌握系統磁碟機資訊。本文整理四大核心功能的實用函數庫,涵蓋序列號讀取、媒體就緒檢查、磁碟機列舉與空間統計。
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'));
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('軟碟機無媒體或未就緒');
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;
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;
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 避免溢位。