5

我想扫描我计算机上所有可用的驱动器号，并获取详细信息（chk 如果被占用，chk 用于类型和大小）。

我对如何使用以下代码获取大小没有任何问题

var
  FreeAvail, totalSpace: Int64;
begin
  if SysUtils.GetDiskFreeSpaceEx(PChar('F:\'), FreeAvail, totalSpace, nil) = True
  then
  begin
    F1.Liner('Drive F total space ');
    F1.pBold(IntToStr(totalSpace div (1024 * 1024 * 1024)) + ' GB ,');
    F1.Liner(' available free space ');
    F1.pBold(IntToStr(FreeAvail div (1024 * 1024 * 1024)) + ' GB.');
  end;
end;

但如果驱动器未被占用，我不喜欢这种情况。

没有媒体时的错误消息

问题：如何获得可用的所有驱动器 - CDROM、USB 记忆棒等。更具体地说，我想要像这个例子一样的显示结果；

驱动器 E [本地磁盘] - TotalSpace 500 GB - FreeSpace 200 GB

驱动器 F [CD 驱动器] - 未占用 - 自由空间 0

驱动器 G [可移动] - TotalSpace 8 GB - FreeSpace 2 GB

4

2 回答 2

11

我提供了一些可能有帮助的功能。第一个使用 Win32 API 函数GetLogicalDriveStrings检索计算机上已分配驱动器号的列表。第二个查询驱动器以查看它是否可以使用（其中有磁盘）。（还有一个实用函数可以将驱动器号转换为所需的整数值DiskSize，即旧的 Pascal I/O 函数。）

该代码从 Win95 天开始就可以运行，并且刚刚在 Delphi 2007 控制台应用程序中的 Win7 64 位上进行了测试。下面包含一个控制台测试应用程序。

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows, Types;

// Returns an array filled wit the assigned
// drive letters on the current computer.
function  GetDriveList: TStringDynArray;
var
  Buff: array[0..128] of Char;
  ptr: PChar;
  Idx: Integer;
begin
  if (GetLogicalDriveStrings(Length(Buff), Buff) = 0) then
    RaiseLastOSError;
  // There can't be more than 26 lettered drives (A..Z).
  SetLength(Result, 26);      

  Idx := 0;
  ptr := @Buff;
  while StrLen(ptr) > 0 do
  begin
    Result[Idx] := ptr;
    ptr := StrEnd(ptr);
    Inc(ptr);
    Inc(Idx);
  end;
  SetLength(Result, Idx);
end;

// Converts a drive letter into the integer drive #
// required by DiskSize().
function DOSDrive( const sDrive: String ): Integer;
begin
  if (Length(sDrive) < 1) then
    Result := -1
  else
    Result := (Ord(UpCase(sDrive[1])) - 64);
end;

// Tests the status of a drive to see if it's ready
// to access. 
function DriveReady(const sDrive: String): Boolean;
var
  ErrMode: Word;
begin
  ErrMode := SetErrorMode(0);
  SetErrorMode(ErrMode or SEM_FAILCRITICALERRORS);
  try
    Result := (DiskSize(DOSDrive(sDrive)) > -1);
  finally
    SetErrorMode(ErrMode);
  end;
end;

// Demonstrates using the above functions.
var
  DrivesArray: TStringDynArray;
  Drive: string;
const
  StatusStr = 'Drive %s is ready: %s';
begin
  DrivesArray := GetDriveList;
  for Drive in  DrivesArray do
    WriteLn(Format(StatusStr, [Drive, BoolToStr(DriveReady(Drive), True)]));
  ReadLn;
end.

在我的系统上运行时的示例输出（Win7 64、两个物理硬盘驱动器（C: 和 D:）、一个未安装映像的 ISO 设备 (E:) 和一个 DVD 驱动器 (Z:)。

Drive C:\ is ready: True 
Drive D:\ is ready: True 
Drive E:\ is ready: False
Drive Z:\ is ready: True
于 2014-10-18T21:20:54.513 回答
6

错误对话框是向后兼容性问题。Windows 的旧版本（更旧）显示了这样的对话框。设计师意识到他们通常是不受欢迎的。应用程序需要能够自己处理这些条件。

但是改变批发会影响那些想要拥有对话框的应用程序。因此引入了一种机制来允许应用程序控制错误处理的某些方面。

您可以通过调用来抑制此类错误对话框SetErrorMode。这允许您抑制对话框，而是让失败的 API 调用返回错误。

启动时调用一次以下函数：

procedure SetProcessErrorMode;
var
  CurrentMode: DWORD;
begin
  CurrentMode := SetErrorMode(0);
  SetErrorMode(CurrentMode or SEM_FAILCRITICALERRORS
    or SEM_NOOPENFILEERRORBOX);
end;

此调用应在启动时进行一次。错误模式是一个进程范围的属性，启动后的修改可能会导致不良和不可预测的副作用。MSDN说：

最佳实践是所有应用程序在启动时使用参数 SEM_FAILCRITICALERRORS 调用进程范围的 SetErrorMode 函数。这是为了防止错误模式对话框挂起应用程序。

我个人SEM_NOOPENFILEERRORBOX也建议添加。

我试图在这里解决您的部分问题，但不是全部。我认为当您一次提出多个问题时这是合理的。

于 2014-10-18T20:38:57.440 回答