How do I know if a directory on Delphi XE2 * is correct *?

I just need to check if the directory exists! But if the directory is "E: \ Test", where E: is a CD / DVD drive and there is no disc on it, I see the following problems with Delphi and Windows.

First method:

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

It gives Range Check Error . I cannot use the blocks {$RANGECHECKS OFF} , {$RANGECHECKS ON} because:

  • It interrupts the current state of the $RANGECHECKS parameter.
  • We will see another system error Drive is not ready instead of Range Check Error . But I just need to check if the directory exists without any error dialogs for the user.

Second method:

 if DirectoryExists(Name, True) then ... 

This function returns True for a nonexistent E:\Test directory on an empty CD / DVD. Therefore, he cannot use it because it does not work correctly.

But then, how do you know if a directory exists?

PS I think that the error exists with any CD / DVD drive. But I use Windows 7 x64 on VMWare Fusion 5 on Mac OS X 10.8.4 with an external CD / DVD drive.

+4
source share
3 answers

Upgrade Delphi XE2 to Delphi XE3 + or use the following function:

 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; 
+1
source

You can simply fix your function so that it does not cause a range check error:

 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; 

Range validation errors are due to the fact that you are mixing signed and unsigned types. Remy also points out a very useful trick to set the compiler options and then restore it to its predominant state. This is a good trick to learn, but you do not need it here.

The XE3 implementation for DirectoryExists has been changed to resolve the issue you are facing. Thus, if using XE3 + was an option, you should accept it.


To disable system error dialogs, call this when the process starts:

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

This is best as described in MSDN :

Best practice is that all applications call the process a broad SetErrorMode function with the SEM_ FAILCRITICALERRORS parameter at startup. This is necessary to prevent dialog box errors from hanging applications.

+4
source

David has the correct answer to avoid a range check error. But if you do not want to do this, you can still disable / enable {$RANGECHECKS} manually, just use {$IFOPT} to do this conditionally, so that the surrounding code will not be affected, for example:

 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; 

It is not enough to check the result of GetFileAttributes() only for INVALID_FILE_ATTRIBUTES . A directory may exist, but is simply not accessible. This is why the RTL DirectoryExists() function checks GetLastError() for several error codes ( ERROR_PATH_NOT_FOUND , ERROR_BAD_NETPATH , ERROR_NOT_READY , etc.), looking for this possible condition. Another thing DirectoryExists() can do is to check if the path specified is really a shortcut to the directory, and if so, check if the target directory exists or not.

Update: Here's the implementation of SysUtils.DirectoryExists() in 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} 

The implementation in XE4 is the same with only one difference - in the Windows version there is also a check for LastError <> ERROR_BAD_NET_NAME when calling GetLastError() .

+3
source

Source: https://habr.com/ru/post/1495792/


All Articles