Visual Basic File API Routines

FindFirstFile: Save a Recursive Search of All Drives to Disk
     
Posted:   Sunday October 9, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

FindFirstFile: Recursive File Search for Single or Multiple File Types (minimal code)
FindFirstFile: Recursive File Search Including/Excluding Single or Multiple File Types (minimal code)
FindFirstFile: Recursive Search for Folders Using a Folder Mask (minimal code)
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
     
 Prerequisites
None.

Here we take the FindFirstFile API recursion principles applied in FindFirstFile: Comparison of FindFirstFile and SearchTreeForFile, but modify the code such that the files and folders returned are stored into a string array, and the array contents is written to disk. To keep things simple, I used a couple of form-level variables to hold the string data and count.

If you've already taken a look at the Recursive Search code, the code will appear straightforward. And while a few routines appear similar to the Recursive Search methods, I have renamed these routines (to indicate their purpose) as well as facilitate adding these same routines to a project that may be using the previous Recursive Search demo functions.

To search for multiple file types (ie a search for all *.frm;*.bas files) by specifying such a pattern as the extension of interest, see FindFirstFile: Recursive File Search for Single or Multiple File Types (minimal code) and FindFirstFile: Recursive File Search Including/Excluding Single or Multiple File Types (minimal code)

 BAS Module Code
None.

 Form Code
Create a new project with a form containing controls as shown in the illustration, and configured as: a combo box (Combo1), three text boxes (top to bottom, Text1, Text2, Text3),  and a command button (Command1). Add the following code to the form:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim nCount As Long
Dim sAllFiles() As String

Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FILE_ATTRIBUTE_FLAGS As Long = FILE_ATTRIBUTE_ARCHIVE Or _
                                            FILE_ATTRIBUTE_HIDDEN Or _
                                            FILE_ATTRIBUTE_NORMAL Or _
                                            FILE_ATTRIBUTE_READONLY

Private Const DRIVE_UNKNOWN As Long = 0
Private Const DRIVE_NO_ROOT_DIR As Long = 1
Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK As Long = 6

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

'the custom-made UDT for searching
Private Type FILE_PARAMS
   bRecurse As Boolean   'set True to perform a recursive search
   bList As Boolean      'set True to add results to listbox
   bFound As Boolean     'set only with SearchTreeForFile methods
   sFileRoot As String   'search starting point, i.e. c:\, c:\windows\
   sFileNameExt As String'filename/filespec to locate, i.e. *.dll, notepad.exe
   sResult As String     'path to file. Set only with SearchTreeForFile methods
   nFileCount As Long    'total file count matching filespec. Set in FindXXX only
   nFileSize As Double   'total file size matching filespec. Set in FindXXX only
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
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 GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, 
   ByVal lpBuffer As String) As Long
      
Private Declare Function GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" _
  (ByVal nDrive As String) As Long
  
  

Private Sub Form_Load()

   With Combo1
      .AddItem "*.*"
      .AddItem "*.dll"
      .AddItem "*.exe"
      .AddItem "*.vbp"
      .AddItem "*.frm"
      .AddItem "*.bas"
      .ListIndex = 0
   End With
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   Erase sAllFiles()
   
End Sub


Private Sub Command1_Click()

   Dim FP As FILE_PARAMS
   
  'set up the display
   Text2.Text = ""
   Text3.Text = ""
   Command1.Enabled = False
   
  'only parameter needed - can be
  'any filespec desired
   With FP
      .sFileNameExt = Combo1.Text
   End With
   
  'dim an array large enough to hold all
  'the returned values
   ReDim sAllFiles(1 To 1000000) As String
         
  'call the routines
   Call GetAllFiles(FP)

  'done. Show the results, and ..
   Text3.Text = Format$(nCount, "###,###,###,##0") & "files found"
   
  'strip off the unused allocated array members
   ReDim Preserve sAllFiles(1 To nCount)
   
  'and save the file
   Call SaveFile(Text1.Text)
   
  'free memory
   Erase sAllFiles()
   
   Command1.Enabled = True
   
End Sub


Private Sub GetFileInformation(FP As FILE_PARAMS)

  'local working variables
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String

  'FP.sFileRoot (assigned to sRoot) contains
  'the path to search.
  
  'FP.sFileNameExt (assigned to sPath) contains
  'the full path and filespec.
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & FP.sFileNameExt

  'obtain handle to the first filespec match
   hFile = FindFirstFile(sPath, WFD)

  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then

      Do

        'Even though this routine may use a filespec,
        '*.* is still valid and will cause the search
        'to return folders as well as files, so a
        'check against folders is still required.
         If Not (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
                 = FILE_ATTRIBUTE_DIRECTORY Then

           'remove trailing nulls
            sTmp = TrimNull(WFD.cFileName)

           'increment count and add to the array
            nCount = nCount + 1
            sAllFiles(nCount) = sRoot & sTmp

         End If

      Loop While FindNextFile(hFile, WFD)

     'close the handle
      hFile = FindClose(hFile)

   End If

End Sub


Private Sub GetAllFiles(FP As FILE_PARAMS)

   Dim drvCount As Long
   Dim sBuffer As String
   Dim currDrive As String
       
  'retrieve the available drives on the system
   sBuffer = Space$(64)
   drvCount = GetLogicalDriveStrings(Len(sBuffer), sBuffer)
   
  'drvCount returns the size of the drive string
   If drvCount Then
   
     'strip off trailing nulls
      sBuffer = Left$(sBuffer, drvCount)
           
     'search each drive for the file
      Do Until sBuffer = ""

        'strip off one drive item from sBuffer
         FP.sFileRoot = StripItem(sBuffer)

        'just search the local file system
         If GetDriveType(FP.sFileRoot) = DRIVE_FIXED Then
         
           'this may take a while, so update the
           'display when the search path changes
            Text2.Text = "Working ... searching drive " & FP.sFileRoot
            Text2.Refresh
            
            Call SearchForFilesArray(FP)
            
           'Update the display count
            Text3.Text = Format$(nCount, "###,###,###,##0") & "files so far.."
            Text3.Refresh
            
         End If
      
      Loop
      
   End If

End Sub


Private Function TrimNull(startstr As String) As String

  'returns the string up to the first
  'null, if present, or the passed string
   Dim pos As Integer
   
   pos = InStr(startstr, Chr$(0))
   
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
  
   TrimNull = startstr
  
End Function


Private Sub SearchForFilesArray(FP As FILE_PARAMS)

  'local working variables
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String
      
  'this routine is primarily interested in the
  'directories, so the file type must be *.*
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & "*.*"
   
  'obtain handle to the first match
   hFile = FindFirstFile(sPath, WFD)
   
  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then
   
     'GetFileInformation function returns the number,
     'of files matching the filespec (FP.sFileNameExt)
     'in the passed folder.
      Call GetFileInformation(FP)

      Do
      
        'if the returned item is a folder...
         If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
            
           'remove trailing nulls
            sTmp = TrimNull(WFD.cFileName)
            
           'and if the folder is not the default
           'self and parent folders...
            If sTmp <> "." And sTmp <> ".." Then
            
              'get the file
               FP.sFileRoot = sRoot & sTmp
               
               
              'This next If..Then just prevents adding extra
              'lines and unneeded paths to the array when a
              'file search is performed for a specific file type
               If FP.sFileNameExt = "*.*" Then
               
                 'Depending on the purpose, you may want to
                 'exclude the next 4 optional lines.
                 'The first two lines adds a blank entry
                 'to the array as a separator between new
                 'directories in the output file. The last
                 'two add the directory name alone, before
                 'listing the files underneath. These four
                 'lines can be optionally commented out).
                 'Obviously, these extra entries will skew
                 'the actual file counts.
                  nCount = nCount + 1
                  sAllFiles(nCount) = ""
                  nCount = nCount + 1
                  sAllFiles(nCount) = FP.sFileRoot
               
               End If
               
              'call again
               Call SearchForFilesArray(FP)
            
            End If
               
            
         End If
         
     'continue looping until FindNextFile returns
     '0 (no more matches)
      Loop While FindNextFile(hFile, WFD)
      
     'close the find handle
      hFile = FindClose(hFile)
   
   End If
   
End Sub


Private Function QualifyPath(sPath As String) As String

  'assures that a passed path ends in a slash
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function


Function StripItem(startStrg As String) As String

  'Take a string separated by Chr(0)'s, and split off 1 item, and
  'shorten the string so that the next item is ready for removal.
   Dim pos As Integer

   pos = InStr(startStrg, Chr$(0))

   If pos Then
      StripItem = Mid$(startStrg, 1, pos - 1)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
   End If

End Function


Private Sub SaveFile(sOutputFile As String)

   Dim cnt As Long
   Dim hFile As Long
   
   Text2.Text = "Writing file ..."
   Text2.Refresh
   
  'obtain the next free file handle from the system
  'and open and save to a normal file - just takes a sec
   hFile = FreeFile
   Open sOutputFile For Output As #hFile
   
   For cnt = 1 To UBound(sAllFiles)
     Print #hFile, sAllFiles(cnt)
   Next
   
   Close #hFile
   
   Text2.Text = "Writing file ... Done!"
   
End Sub
 Comments
Before running, assure that you specify a valid drive, path and filename in Text1 for the output file.

Note: While it may be convenient to utilize VB's built-in constants in place of the FILE_ATTRIBUTE_* API values, care must be taken. There is a difference between related constant values that may cause unexpected performance at some point. For example, the constant 'vbNormal' is defined as having a value of 0, whereas the API FILE_ATTRIBUTE_NORMAL has a value of &H80 (decimal 128).


 
 

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