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;

它给出了Range Check Error。我无法使用{$RANGECHECKS OFF}，{$RANGECHECKS ON}块，因为：

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

第二种方法：

if DirectoryExists(Name, True) then ...

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

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

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

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所述的最佳做法：

最佳做法是所有应用程序调用该过程 - 参数为SEM_的宽SetErrorMode函数 FAILCRITICALERRORS在启动时。这是为了防止错误模式悬挂应用程序的对话框。

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

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;

如何正确查看Delphi XE2 上是否存在目录？

3 个答案:

如何正确查看Delphi XE2 *上是否存在目录*？

3 个答案:

如何正确查看Delphi XE2 上是否存在目录？