如何在Delphi XE2中*正确地*查找目录是否存在？

Question

我只需要检查一个目录是否存在！但是如果目录是"E:\Test"，其中E:是CD / DVD驱动器，并且没有插入磁盘，我会遇到以下Delphi和Windows问题。

第一种方法：

function DirExists(Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributesW(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

它会报“范围检查错误”。我无法使用{$RANGECHECKS OFF}、{$RANGECHECKS ON} 块，因为：

1. 它会破坏当前的$RANGECHECKS选项状态。
2. 我们会看到另一个系统错误“驱动器未准备好”，而不是“范围检查错误”。但我只需要检查目录是否存在，而不需要任何用户错误对话框。

第二种方法：

if DirectoryExists(Name, True) then ...

这个函数在空的CD/DVD驱动器上对不存在的E:\Test目录返回True，所以不能使用它，因为其行为不正确。

那么，如何判断一个目录是否存在？

P.S. 我认为这个错误在任何CD/DVD驱动器上都存在。但我是在Mac OS X 10.8.4下使用VMWare Fusion 5的Windows 7 x64来访问外部CD/DVD驱动器。

- Dmitry

---

好奇怪 - DirectoryExists() 确实在我的电脑上返回空的 DVD 驱动器的 true。使用 Delphi XE 和 Windows 8。 - Leonardo Herrera

我应该如何正确地编写它？ - Dmitry

这是directoryexists的一个长期存在的bug。在这里查看。我手头没有解决方案。 - Rik

在XE3中，他们添加了一个检查ERROR_NOT_READY的功能来“修复”这个问题。对我来说，这一切似乎非常虚假。 - David Heffernan

@Altaveron，这个问题不应该在XE3+中修复；它应该在XE2中修复。当我销售软件时，任何由我们引起的问题都会免费修复，终身保修。当你销售软件时，你说“产品可以做到X”。如果它不能做到X（有bug），那就是在撒谎。拒绝履行协议（修复软件使其能够做到X）是欺骗客户，在我看来。EMBT通过要求更新来修复错误而进行勒索，这是开源开发工具击败他们的众多原因之一。 - alcalde

Answer 1

您可以修复您的函数，以避免引起范围检查错误：

function DirExists(Name: string): Boolean;
var
  Code: DWORD;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> INVALID_FILE_ATTRIBUTES) 
    and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

范围检查错误是由于您混合使用有符号和无符号类型引起的。Remy还指出了一种非常有用的技巧，即设置编译器选项，然后将其恢复到当前状态。这是一个很好的技巧，但在这里您不需要它。

DirectoryExists的XE3实现已经修改以解决您遇到的问题。因此，如果使用XE3+是一个选项，那么您应该采取它。

---

在进程启动时调用以下内容以抑制系统错误对话框：

procedure SetProcessErrorMode;
var
  Mode: DWORD;
begin
  Mode := SetErrorMode(SEM_FAILCRITICALERRORS);
  SetErrorMode(Mode or SEM_FAILCRITICALERRORS);
end;

根据MSDN上的描述，这样做是最佳实践：

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

- David Heffernan

---

但是错误对话框会在整个项目中被抑制吗？为了检查一个单元中是否存在目录，不可能破坏整个项目的逻辑。 - Dmitry

@Altaveron 如果是在Win7上，可以使用SetThreadErrorMode函数代替（如果需要），并在之后恢复错误模式。不过，如果您的程序是一个可执行文件，则应该添加FAILCRITICALERRORS。默认的错误模式是为了保持向后兼容性，但您永远不想看到那些对话框。您希望函数调用失败，并且您可以自己报告错误。 - David Heffernan

David，你的方法真的很难懂。因此，我的老板不会相信我需要花很多时间来了解错误模式只是为了检查目录是否存在... - Dmitry

@Altaveron，我不确定我能在这方面帮到你。要么你想抑制对话框，要么你不想。无论如何，指向文档对你的老板来说是否足够了：系统不显示关键错误处理程序消息框。相反，系统将错误发送到调用进程。 最佳实践是所有应用程序在启动时调用进程范围的SetErrorMode函数，并将参数设置为SEM_FAILCRITICALERRORS。这是为了防止错误模式对话框挂起应用程序。 - David Heffernan

我无法对我看不到的代码进行评论。但是，我可以保证我回答中的代码永远不会引发范围检查边界错误。而且，我可以通过静态分析来保证这一点。如果这还不够，您可以检查生成的代码。您会发现没有调用BoundErr。因此，编译器也能够通过其静态分析保证没有范围错误。 - David Heffernan

Answer 2

在避免范围检查错误方面，David的答案是正确的。但如果你不想这样做，仍然可以手动开启/关闭{$RANGECHECKS}，只需使用{$IFOPT}以条件方式执行，以便周围的代码不受影响，例如：

function DirExists(Name: string): Boolean;
var
  Code: Integer;
begin
  {$IFOPT R+}
    {$DEFINE _RPlusWasEnabled}
    {$R-}
  {$ENDIF}

  Code := GetFileAttributesW(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);

  {$IFDEF _RPlusWasEnabled}
    {$UNDEF _RPlusWasEnabled}
    {$R+}
  {$ENDIF}
end;

说了这么多，仅仅检查GetFileAttributes()的结果是否为INVALID_FILE_ATTRIBUTES是不够的。一个目录可能存在但无法访问。因此RTL的DirectoryExists()函数会检查GetLastError()多个错误代码（例如ERROR_PATH_NOT_FOUND、ERROR_BAD_NETPATH、ERROR_NOT_READY等），以寻找这种可能的情况。另外，DirectoryExists()还可以选择性地检查指定的路径是否实际上是目录的快捷方式，并在这种情况下检查目标目录是否存在。

更新：以下是XE3中SysUtils.DirectoryExists()的实现：

function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean;
{$IFDEF MSWINDOWS}
var
  Code: Cardinal;
  Handle: THandle;
  LastError: Cardinal;
begin
  Result := False;
  Code := GetFileAttributes(PChar(Directory));

  if Code <> INVALID_FILE_ATTRIBUTES then
  begin
    if faSymLink and Code = 0 then
      Result := faDirectory and Code <> 0
    else
    begin
      if FollowLink then
      begin
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
        if Handle <> INVALID_HANDLE_VALUE then
        begin
          CloseHandle(Handle);
          Result := faDirectory and Code <> 0;
        end;
      end
      else if faDirectory and Code <> 0 then
        Result := True
      else
      begin
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
        if Handle <> INVALID_HANDLE_VALUE then
        begin
          CloseHandle(Handle);
          Result := False;
        end
        else
          Result := True;
      end;
    end;
  end
  else
  begin
    LastError := GetLastError;
    Result := (LastError <> ERROR_FILE_NOT_FOUND) and
      (LastError <> ERROR_PATH_NOT_FOUND) and
      (LastError <> ERROR_INVALID_NAME) and
      (LastError <> ERROR_BAD_NETPATH) and
      (LastError <> ERROR_NOT_READY);
  end;
end;
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
var
  StatBuf, LStatBuf: _stat;
  Success: Boolean;
  M: TMarshaller;
begin
  Success := stat(M.AsAnsi(Directory, CP_UTF8).ToPointer, StatBuf) = 0;
  Result := Success and S_ISDIR(StatBuf.st_mode);

  if not Result and (lstat(M.AsAnsi(Directory, CP_UTF8).ToPointer, LStatBuf) = 0) and
    S_ISLNK(LStatBuf.st_mode) then
  begin
    if Success then
      Result := S_ISDIR(StatBuf.st_mode)
    else if not FollowLink then
      Result := True;
  end;
end;
{$ENDIF POSIX}

XE4中的实现与之前的版本相同，唯一的区别是windows版本在调用GetLastError()时还包括一个检查LastError <> ERROR_BAD_NET_NAME。

- Remy Lebeau

---

@DavidHeffernan：GetFileAttributes()返回的错误代码仅意味着无法检索属性，但您必须查看错误代码以找出为什么无法检索属性。只有在目录确实不存在时才会发生某些错误代码。其他错误代码表示目录确实存在，但无法访问。 DirectoryExists()类型的函数的目的是确定存在性，而不是可访问性，因此需要相应地分析错误代码。 - Remy Lebeau

@Altaveron：DirectoryExists()的源代码已经添加到我的答案中。 - Remy Lebeau

Embarcadero 应该更新 FileExists() 和 DirectoryExists() 函数，使用 PathFileExists() 和 PathIsDirectory() 替代 GetFileAttributes()。这两个函数自 Win2K 以来就已存在。 - Remy Lebeau

我刚在QC中创建了一个工单：#117699。 - Remy Lebeau

PathFileExists和PathIsDirectory似乎仅限于MAX_PATH。 - David Heffernan

Answer 3

更新 Delphi XE2 到 Delphi XE3+ 或使用以下函数：

function DirectoryExistsDelphiXE2(const Directory: string; FollowLink: Boolean = True): Boolean;
var
  Code: Cardinal;
  Handle: THandle;
  LastError: Cardinal;
begin
  Result := False;
  Code := GetFileAttributes(PChar(Directory));

  if Code <> INVALID_FILE_ATTRIBUTES then
  begin
    if faSymLink and Code = 0 then
      Result := faDirectory and Code <> 0
    else
    begin
      if FollowLink then
      begin
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
        if Handle <> INVALID_HANDLE_VALUE then
        begin
          CloseHandle(Handle);
          Result := faDirectory and Code <> 0;
        end;
      end
      else if faDirectory and Code <> 0 then
        Result := True
      else
      begin
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
        if Handle <> INVALID_HANDLE_VALUE then
        begin
          CloseHandle(Handle);
          Result := False;
        end
        else
          Result := True;
      end;
    end;
  end
  else
  begin
    LastError := GetLastError;
    Result := (LastError <> ERROR_FILE_NOT_FOUND) and
      (LastError <> ERROR_PATH_NOT_FOUND) and
      (LastError <> ERROR_INVALID_NAME) and
      (LastError <> ERROR_BAD_NETPATH) and
      (LastError <> ERROR_NOT_READY);
  end;
end;

- Dmitry

---

这并没有解决问题的另一部分。 - David Heffernan

这部分代码可能会出现另一个系统错误“驱动器未准备好”，而不是“范围检查错误”。但我只需要检查目录是否存在，而不需要弹出任何错误对话框给用户。 - David Heffernan

我在XE3中使用DirectoryExists()时没有发现任何错误 - 它按照要求正常工作。 - Dmitry

在我的测试中，即使在XE2上，我也没有看到系统错误对话框。XE2和XE3实现DirectoryExists之间的更改不会影响系统错误对话框。如果您再次执行触发这些对话框的操作，即使使用XE3代码，对话框仍将出现。您真的应该听取MS的建议并添加SEM_FAILCRITICALERRORS。您肯定希望在代码中处理任何错误，而不是显示那些对话框，对吧？或者您是否真的想要看到系统错误对话框？ - David Heffernan

看起来系统错误对话框并不是由DirectoryExists引起的，而是由于DirectoryExists的输出结果与您预期的不同而导致的某些后续操作。然而，仅仅因为您修复了DirectoryExists中的这个故障模式，并不意味着所有故障都已经修复。如果您不抑制系统错误，则不要惊讶当它们出现在其他场景中。 - David Heffernan