4

我只需要检查一个目录是否存在！但是如果目录是“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;

它给Range Check Error. 我不能使用{$RANGECHECKS OFF},{$RANGECHECKS ON}块，因为：

  1. $RANGECHECKS它打破了选项的当前状态。
  2. 我们将看到另一个系统Drive is not ready错误Range Check Error。但我只需要检查目录是否存在而没有任何用户错误对话框。

第二种方法：

if DirectoryExists(Name, True) then ...

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

但是，如何找出目录是否存在？

PS 我认为任何 CD/DVD 驱动器都存在错误。但是我在带有外部 CD/DVD 驱动器的 Mac OS X 10.8.4 下的 VMWare Fusion 5 上使用 Windows 7 x64。

4

3 回答 3

4

您可以修复您的功能，使其不会导致范围检查错误：

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上描述的最佳实践：

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

于 2013-08-07T17:25:42.543 回答
3

大卫在避免范围检查错误方面有正确的答案。但是如果你不想这样做，你仍然可以{$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()for的结果INVALID_FILE_ATTRIBUTES是不够的。目录可能存在但无法访问。这就是为什么 RTL 的DirectoryExists()函数会检查GetLastError()多个错误代码（ERROR_PATH_NOT_FOUND、ERROR_BAD_NETPATH、ERROR_NOT_READY等）以寻找可能的情况。可以做的另一件事DirectoryExists()是可选地检查指定路径是否实际上是目录的快捷方式，如果是，则检查目标目录是否存在。

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

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 版本还包括LastError <> ERROR_BAD_NET_NAME调用时的检查GetLastError()。

于 2013-08-07T17:53:16.970 回答
1

将 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;
于 2013-08-07T18:08:49.533 回答