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

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来检索计算机上分配的驱动器号的列表.第二个查询驱动器以查看它是否可以使用(其中有一个磁盘).(还有一个实用程序函数可以将驱动器号转换为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

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.

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