The Optimum FileExists Function
The ideal implementation of FileExists should be simple, efficient, supports wildcards and above all else, work flawlessly in all scenarios. In the refined to near perfection version 11.0 below, all of those are met, except one. For that single shortcoming, v7.0 fills the role adequately. Bonus: A few related routines are included as well.
AI
Resumo por IA: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Código fonte
<PRE><FONT color="#000080">Attribute</FONT> VB_Name = <FONT color="#800000">"modFileExists"</FONT><FONT color="#008000">
'=========================================================================
' The Optimum FileExists Function
'
'The ideal implementation of FileExists should be simple, efficient,
'supports wildcards and above all else, work flawlessly in all scenarios.
'In the refined to near perfection version 11.0 below, all of those are
'met, except one. For that single shortcoming, v7.0 fills the role
'adequately.
'
'Bonus: A few related routines are included as well.
'=========================================================================</FONT>
<FONT color="#000080">
Option Explicit
</FONT>
<FONT color="#000080">Private Const</FONT> DRIVE_NO_ROOT_DIR <FONT color="#000080">As Long</FONT> = <FONT color="#800080">1</FONT>
<FONT color="#000080">Private Const</FONT> ERROR_SHARING_VIOLATION <FONT color="#000080">As Long</FONT> = <FONT color="#800080">32</FONT>
<FONT color="#000080">Private Const</FONT> MAX_PATH <FONT color="#000080">As Long</FONT> = <FONT color="#800080">260</FONT>
<FONT color="#000080">
Private Type</FONT> FILETIME
dwLowDateTime <FONT color="#000080">As Long</FONT>
dwHighDateTime <FONT color="#000080">As Long
End Type
</FONT><FONT color="#000080">
Private Type</FONT> WIN32_FIND_DATA
dwFileAttributes <FONT color="#000080">As Long</FONT>
ftCreationTime <FONT color="#000080">As</FONT> FILETIME
ftLastAccessTime <FONT color="#000080">As</FONT> FILETIME
ftLastWriteTime <FONT color="#000080">As</FONT> FILETIME
nFileSizeHigh <FONT color="#000080">As Long</FONT>
nFileSizeLow <FONT color="#000080">As Long</FONT>
dwReserved0 <FONT color="#000080">As Long</FONT>
dwReserved1 <FONT color="#000080">As Long</FONT>
cFileName <FONT color="#000080">As String</FONT> * MAX_PATH
cAlternate <FONT color="#000080">As String</FONT> * <FONT color="#800080">14</FONT>
<FONT color="#000080">End Type
</FONT><FONT color="#000080">
Private Declare Function</FONT> FindClose <FONT color="#000080">Lib</FONT> <FONT color="#800000">"kernel32"</FONT> ( _
<FONT color="#000080">ByVal</FONT> hFindFile <FONT color="#000080">As Long</FONT> _
) <FONT color="#000080">As Long
Private Declare Function</FONT> FindFirstFileW <FONT color="#000080">Lib</FONT> <FONT color="#800000">"kernel32"</FONT> ( _
<FONT color="#000080">ByVal</FONT> lpFileName <FONT color="#000080">As Long</FONT>, _
<FONT color="#000080">ByRef</FONT> lpFindFileData <FONT color="#000080">As</FONT> WIN32_FIND_DATA _
) <FONT color="#000080">As Long
</FONT>
<FONT color="#000080">
Private Declare Function</FONT> GetDriveTypeW <FONT color="#000080">Lib</FONT> <FONT color="#800000">"kernel32"</FONT> ( _
<FONT color="#000080">ByVal</FONT> lpRootPathName <FONT color="#000080">As Long</FONT> _
) <FONT color="#000080">As Long
</FONT>
<FONT color="#000080">
Private Declare Function</FONT> GetFileAttributesW <FONT color="#000080">Lib</FONT> <FONT color="#800000">"kernel32"</FONT> ( _
<FONT color="#000080">ByVal</FONT> lpFileName <FONT color="#000080">As Long</FONT> _
) <FONT color="#000080">As Long
</FONT>
<FONT color="#000080">
Private Declare Function</FONT> PathFileExistsW <FONT color="#000080">Lib</FONT> <FONT color="#800000">"shlwapi"</FONT> ( _
<FONT color="#000080">ByVal</FONT> pszPath <FONT color="#000080">As Long</FONT> _
) <FONT color="#000080">As Long
Private Declare Function</FONT> PathIsDirectoryW <FONT color="#000080">Lib</FONT> <FONT color="#800000">"shlwapi"</FONT> ( _
<FONT color="#000080">ByVal</FONT> pszPath <FONT color="#000080">As Long</FONT> _
) <FONT color="#000080">As Long</FONT>
<FONT color="#008000">
'=========================================================================
</FONT><FONT color="#000080">
Public Function</FONT> FileExists(<FONT color="#000080">ByRef</FONT> sFileName <FONT color="#000080">As String</FONT>) <FONT color="#000080">As Boolean</FONT><FONT color="#008000">
'······························· v1.0 ································
'
'Naive beginner's initial attempt.
'
'If Dir$(sFileName, vbArchive) = "" And </FONT>_<FONT color="#008000">
' Dir$(sFileName, vbHidden) = "" And </FONT>_<FONT color="#008000">
' Dir$(sFileName, vbReadOnly) = "" And </FONT>_<FONT color="#008000">
' Dir$(sFileName, vbSystem) = "" Then
' FileExists = False
'Else
' FileExists = True
'End If
'
'······························· v2.0 ································
'
'One-liner form of the above. Unwittingly made worse by use of IIf.
'
'FileExists = IIf(Dir$(sFileName, vbArchive) = "" And </FONT>_<FONT color="#008000">
' Dir$(sFileName, vbHidden) = "" And </FONT>_<FONT color="#008000">
' Dir$(sFileName, vbReadOnly) = "" And </FONT>_<FONT color="#008000">
' Dir$(sFileName, vbSystem) = "", False, True)
'
'······························· v3.0 ································
'
'Code inspired by Kevin Wilson (<A href="http://www.thevbzone.com/modCommon.bas">www.thevbzone.com</A>) & Francesco Balena.
'
'FileExists = Dir$(sFileName, vbArchive Or vbHidden Or </FONT>_<FONT color="#008000">
' vbReadOnly Or vbSystem) <> ""
'
'······························· v4.0 ································
'
'Exits early if sFileName is empty, returning the default value False.
'
'On Error Resume Next
'If LenB(sFileName) Then </FONT>_<FONT color="#008000">
' FileExists = Dir$(sFileName, vbArchive Or vbHidden Or </FONT>_<FONT color="#008000">
' vbReadOnly Or vbSystem) <> vbNullString
'
'······························· v5.0 ································
'
'Rejects Directories/Folders, returning the default value False.
'
'On Error Resume Next
'If LenB(sFileName) Then If Right$(sFileName, 1) <> "\" Then </FONT>_<FONT color="#008000">
' FileExists = Dir$(sFileName, vbArchive Or vbHidden Or </FONT>_<FONT color="#008000">
' vbReadOnly Or vbSystem) <> vbNullString
'
'······························· v6.0 ································
'
'Doesn't accept wildcards. Opening a locked file fails.
'"Close FreeFile - 1" may not always work as expected.
'
'On Error Resume Next
'Open sFileName For Input As FreeFile
' FileExists = (Err = 0)
'Close FreeFile - 1
'
'······························· v7.0 ································
'
'Wide version of FindFirstFile API allows Unicode filenames and makes
'passing the string faster thus contributing to the overall efficiency
'of this code. Supports wildcards.
'
'Dim WFD As WIN32_FIND_DATA
'If LenB(sFileName) Then </FONT>_<FONT color="#008000">
' FileExists = FindClose(FindFirstFileW(StrPtr(sFileName), WFD)) <> 0
'
'······························· v8.0 ································
'
'GetAttr throws an error with empty strings, wildcards, hiberfil.sys,
'pagefile.sys, NUL, CON, COM1, etc. thus causing False to be returned.
'Directories/Folders are excluded by the test.
'
'On Error Resume Next
'FileExists = (GetAttr(sFileName) And vbDirectory) <> vbDirectory
'
'······························· v9.0 ································
'
'Does not recognize wildcards, hiberfil.sys & pagefile.sys, thus returns
'False. Ignores Directories/Folders if assisted by PathIsDirectory
'or similar.
'
'If PathIsDirectoryW(StrPtr(sFileName)) = False Then </FONT>_<FONT color="#008000">
' FileExists = PathFileExistsW(StrPtr(sFileName))
'
'······························ v10.0 ································
'
'The Scripting version is much slower than any of the others,
'even if it is referenced. Wildcards not supported.
'
'Dim FSO As Object 'Or FSO As New FileSystemObject
'Set FSO = CreateObject("Scripting.FileSystemObject")
'FileExists = FSO.FileExists(sFileName)
'Set FSO = Nothing
'
'······························ v11.0 ································
'
'Wildcards unsupported but this is the fastest file existence test yet.
'<A href="http://blogs.msdn.com/b/oldnewthing/archive/2007/10/23/5612082.aspx">Superstition: Why is GetFileAttributes the way old-timers</A>
'<A href="http://blogs.msdn.com/b/oldnewthing/archive/2007/10/23/5612082.aspx">test file existence?</A> (by Raymond Chen)
'<A href="http://www.enzinger.net/en/Filetest.html">Check if a file exists</A> (by Wolfgang Enzinger)
'</FONT>
<FONT color="#000080">Select Case</FONT> (GetFileAttributesW(StrPtr(sFileName)) <FONT color="#000080">And</FONT> vbDirectory) = <FONT color="#800080">0</FONT>
<FONT color="#000080">Case True</FONT>: FileExists = <FONT color="#000080">True</FONT>
<FONT color="#000080">Case Else</FONT>: FileExists = (Err.LastDllError = ERROR_SHARING_VIOLATION)
<FONT color="#000080">End Select</FONT><FONT color="#008000">
'
'······························ v12.0 ································
'
'This one-liner form of the above does the LastDllError check everytime.
'
'FileExists = ((GetFileAttributesW(StrPtr(sFileName)) And vbDirectory) </FONT>_<FONT color="#008000">
' = 0) Or (Err.LastDllError = ERROR_SHARING_VIOLATION)</FONT><FONT color="#000080">
End Function
</FONT><FONT color="#008000">
'=========================================================================
</FONT><FONT color="#000080">
Public Function</FONT> DirExists(<FONT color="#000080">ByRef</FONT> sPath <FONT color="#000080">As String</FONT>) <FONT color="#000080">As Boolean</FONT>
DirExists = Abs(GetFileAttributesW(StrPtr(sPath))) <FONT color="#000080">And</FONT> vbDirectory
<FONT color="#000080">End Function
</FONT><FONT color="#000080">
Public Function</FONT> DriveExists(<FONT color="#000080">ByRef</FONT> sDrive <FONT color="#000080">As String</FONT>) <FONT color="#000080">As Boolean</FONT>
DriveExists = GetDriveTypeW(StrPtr(sDrive)) <> DRIVE_NO_ROOT_DIR
<FONT color="#000080">End Function
</FONT><FONT color="#000080">
Public Function</FONT> GetVolumeLabel(<FONT color="#000080">ByRef</FONT> sDrive <FONT color="#000080">As String</FONT>) <FONT color="#000080">As String</FONT>
GetVolumeLabel = Dir$(sDrive, vbVolume)
<FONT color="#000080">End Function
</FONT></PRE>
Comentários originais (3)
Recuperado do Wayback Machine