获取有效的驱动器号并被占用

Question

我想扫描计算机上存在的所有可用驱动器号， 并获得详细信息（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驱动器] - 未占用 - FreeSpace 0

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

Answer 1

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

自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

Answer 2

错误对话框是向后兼容性问题。 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。

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