Visual Basic File API Routines

FindFirstFile: Fastest Tests for Files or Subfolders
     
Posted:   Thursday December 30, 2004
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

 

FindFirstFile: Changing File and/or Folder Attributes Recursively
FindFirstFile: Fast Directory File Count

FindFirstFile: Extract Filename from a Full Path
FindFirstFile: Performance Comparison - FSO vs. API
FindFirstFile: Comparison of FindFirstFile and SearchTreeForFile
FindFirstFile: Save a Recursive Search of All Drives to Disk
FindFirstFile: Save a Recursive Search of Specified Drives to Disk
GetFileVersionInfo: File Search and File Property Info
GetLogicalDriveStrings: An API 'DriveExists' Routine
FindFirstFile: An API 'FileExists' Routine
FindFirstFile: An API 'FolderExists' Routine
PathFileExists: A Local/Network File/Folder/Drive Exists Routine
     
 Prerequisites
None.

As an inadvertent call to Dir() can muck up an already-executing routine using Dir(), here are a couple of blistering fast alternatives for determining if a specified folder contains either subfolders or files. This could be used to determine if a folder could be deleting with Kill, or simply has a means to test whether a folder is completely empty.

The routine is non-recursive, as by definition its use would be to determine if even one file or subfolder existed. It also does not return the folder or file name found, just a simple Boolean true or false.

 BAS Module Code
None.

 Form Code
Drop a text box (Text1), two labels (Label1, Label2) and a command button (Command1) onto a form, and add the following:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE = -1

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long



Private Sub Form_Load()

   Text1.Text = "c:\windows"
   Command1.Caption = "Check for Folders/Files"
   
End Sub


Private Sub Command1_Click()
 
   Dim sRootPath As String
   Dim bResult1 As Boolean
   Dim bResult2 As Boolean
   
   sRootPath = QualifyPath(Text1.Text)
   Text1.Text = sRootPath 'reflect any change

   bResult1 = FolderContainsSubfolders(sRootPath)
   bResult2 = FolderContainsFiles(sRootPath)
   
   Select Case bResult1
      Case True
         Label1.Caption = sRootPath & " contains subfolders"
      Case Else
         Label1.Caption = "There are no subfolders under " & sRootPath
   End Select
   
   Select Case bResult2
      Case True
         Label2.Caption = sRootPath & " contains files"
      Case Else
         Label2.Caption = "There are no files in " & sRootPath
   End Select

End Sub


Private Function FolderContainsSubfolders(sRoot As String) As Boolean

   Dim wfd As WIN32_FIND_DATA
   Dim hFile As Long

   hFile = FindFirstFile(sRoot & "*.*", wfd)
   
   If hFile <> INVALID_HANDLE_VALUE Then
   
      Do
         If (wfd.dwFileAttributes And vbDirectory) Then
            
           'an item with the vbDirectory bit was found
           'but is it a system folder?         
            If (Left$(wfd.cFileName, 1) <> ".") And _
               (Left$(wfd.cFileName, 2) <> "..") Then
               
              'nope, it's a user folder 
               FolderContainsSubfolders = True
               Exit Do
                                 
            End If
         End If
      
      Loop While FindNextFile(hFile, wfd)
   
   End If
  
   Call FindClose(hFile)

End Function


Private Function FolderContainsFiles(sRoot As String) As Boolean

   Dim wfd As WIN32_FIND_DATA
   Dim hFile As Long

   hFile = FindFirstFile(sRoot & "*.*", wfd)
   
   If hFile <> INVALID_HANDLE_VALUE Then
   
      Do
        'if the vbDirectory bit's not set, it's a 
        'file so we're done!
         If (Not (wfd.dwFileAttributes And vbDirectory) = vbDirectory) Then
         
            FolderContainsFiles = True
            Exit Do

         End If
      
      Loop While FindNextFile(hFile, wfd)
   
   End If
  
   Call FindClose(hFile)

End Function


Private Function QualifyPath(sPath As String) As String
 
   If Len(sPath) > 0 Then
 
      If Right$(sPath, 1) <> "\" Then
         QualifyPath = sPath & "\"
      Else
         QualifyPath = sPath
      End If
   
   Else
      QualifyPath = ""
   End If
   
End Function
 Comments
Alter the text box string to see the results of non-existent folders, root folders, or other directories. The routine could be modified to return True if a specific type of file was found by modifying the *.* in the FindFirstFile call in the FolderContainsFiles routine. (It must remain *.* to locate folders in FolderContainsSubfolders).

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter