Visual Basic File API Routines

FindFirstFile: Changing File and/or Folder Attributes Recursively
     
Posted:   Sunday March 25, 2001
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows 2000
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.

The basic recursion techniques from FindFirstFile: Comparison of FindFirstFile and SearchTreeForFile are used in this demo, but modified to include code for changing either the file, folders or both beneath the target directory specified. The code returns to the list all files processed, as well as a count of all files and folders, the number that were actually changed, as well as the elapsed time. As the illustration shows, this is a damn fast technique.

Note: The demo uses the VB6 FormatNumber function, which is not available in VB4-32 or VB5. Users of these versions should use Format$() instead.

To search for multiple file types (i.e. 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).  The attribute code from this routine can be added to these methods to provide attribute-searching functionality for a set of specific file masks.

 BAS Module Code
None.

 Form Code
Create a new project form similar to the illustration (from top to bottom, left to right): Text1, Text2, Frame1 containing three options buttons in a control array (Option1(0) - Option1(2) and one checkbox (Check2), Frame 2 containing five check boxes in a control array (Check1(0) - Check1(4), one command button (Command1). Below the frames are Text3 and List1. The code will set the captions for the controls. Add labels as needed, and 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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const vbDot = 46
Private Const MAXDWORD As Long = &HFFFFFFFF
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800

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

'custom UDT for searching
Private Type FILE_PARAMS
   bRecurse As Boolean          'set True to perform recursive search  
   sFileRoot As String          'search starting point, i.e. c:\, c:\winnt\
   sFileNameExt As String       'filename/filespec to locate, i.e. *.*
   bChangeFileAttr As Boolean   'new - flag set when Files specified
   bChangeFolderAttr As Boolean 'new - flag set when Folders specified
   nChangedAttr As Long         'new - new attribute for files/folders
   checked As Long              'new - total files examined
   cnt As Long                  'total file count matching filespec
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 GetTickCount Lib "kernel32" () As Long



Private Sub Form_Load()

   Option1(0).Caption = "Files Only"
   Option1(1).Caption = "Folders Only"
   Option1(2).Caption = "Both Files and Folders"
   
   Check1(0).Caption = "Normal"
   Check1(1).Caption = "Read Only"
   Check1(2).Caption = "Hidden"
   Check1(3).Caption = "System"
   Check1(4).Caption = "Archive"
   
   Option1(0).Value = True
   Check1(0).Value = 1
   
   Command1.Caption = "Change"
   
End Sub


Private Sub Command1_Click()

   Dim fp As FILE_PARAMS

   Dim tstart As Single
   Dim tend As Single
   Dim nIndex As Long
  
  'set flags indicating the scope of
  'change desired, based on the option
  'button selected
   nIndex = GetSelectedOptionIndex()
   fp.bChangeFileAttr = (nIndex = 0) Or (nIndex = 2)
   fp.bChangeFolderAttr = (nIndex = 1) Or (nIndex = 2)
   
   
  'fill variable with the desired
  'file attributes
   fp.nChangedAttr = 0
   If Check1(0).Value = 1 Then fp.nChangedAttr = vbNormal
   If Check1(1).Value = 1 Then fp.nChangedAttr = fp.nChangedAttr Or vbReadOnly
   If Check1(2).Value = 1 Then fp.nChangedAttr = fp.nChangedAttr Or vbHidden
   If Check1(3).Value = 1 Then fp.nChangedAttr = fp.nChangedAttr Or vbSystem
   If Check1(4).Value = 1 Then fp.nChangedAttr = fp.nChangedAttr Or vbArchive
   
  'set up the remaining File_Params
   With fp
      .sFileRoot = Text1.Text
      .sFileNameExt = Text2.Text
      .bRecurse = Check2.Value = 1
   End With
   
  'and do it. Since the files found are
  'being added to the listbox, we toggle
  'the list's visibility state to increase
  'performance. In addition, GetTickCount
  'returns the elapsed time for the operation.
   List1.Visible = False
   List1.Clear
   Text3.Text = ""
   
   tstart = GetTickCount()

      Call SearchForFiles(fp)
   
   tend = GetTickCount()
   
   List1.Visible = True
   
  'done - show the results
   Text3.Text = "Elapsed: " & FormatNumber((tend - tstart) / 1000, 2) & _
                " seconds.  Objects checked: " & FormatNumber(fp.checked, 0) & _
                ".  Changed: " & FormatNumber(fp.cnt, 0) & _
                " (" & fp.sFileNameExt & ")"

                                    
End Sub


Private Function GetSelectedOptionIndex() As Long

  'returns the selected item index from
  'an option button array. Much cooler
  'than multiple If...Then statements!
  'If your array contains more elements,
  'just append them to the test condition,
  'setting the multiplier to the button's
  'negative -index.
   GetSelectedOptionIndex = Option1(0).Value * 0 Or _
                            Option1(1).Value * -1 Or _
                            Option1(2).Value * -2
End Function


Private Function GetFileInformation(fp As FILE_PARAMS) As Long

  '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
   Dim sExt 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 uses filespecs,
        '*.* 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
                        
           'if changing the file atrributes,
           'remove trailing nulls, add to list
           'and add to total count
            If fp.bChangeFileAttr Then
            
               sTmp = TrimNull(WFD.cFileName)
               SetAttr sRoot & sTmp, fp.nChangedAttr
               List1.AddItem sRoot & sTmp
               
              'this tracks how many items were changed
               fp.cnt = fp.cnt + 1
            
            End If
            
           'this tracks how many items were examined
            fp.checked = fp.checked + 1
         
         End If
         
      Loop While FindNextFile(hFile, WFD)
      
     'close handle
      hFile = FindClose(hFile)
   
   End If
   
End Function


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 SearchForFiles(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
      
  'this method uses *.* to locate everything.
  'The GetFileInformation routine uses the
  'file extension specified in its search.
  'This allows retrieval of folders as well
  'as the specified file type.
   sRoot = QualifyPath(fp.sFileRoot)
   sPath = sRoot & "*.*"
   
  'obtain handle to the first match
   hFile = FindFirstFile(sPath, WFD)
   
  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then
   
     'This is where the method obtains the file
     'list and data for the folder passed.
      Call GetFileInformation(fp)

      Do
      
        'if the returned item is a folder
         If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
            = FILE_ATTRIBUTE_DIRECTORY Then
             
           'if the Recurse flag was specified
            If fp.bRecurse Then
                          
              'this checks that the first char in the
              'filename is not one of the system special
              'folders (. or ..) before performing recursion
               If Asc(WFD.cFileName) <> vbDot Then
                                
                 'found a folder, it is not one to
                 'the two system folder types, so
                 'begin a recursive search of it
                     
                 'remove trailing nulls and assign
                 'new search path
                  fp.sFileRoot = sRoot & TrimNull(WFD.cFileName)
                  Call SearchForFiles(fp)
                  
               End If  'If Asc
            End If  'If fp.bRecurse
            
           'if changing folder attributes do it now.
           'This assures changes won't prevent methods
           'from examining subfolders.
            If fp.bChangeFolderAttr Then
            
              'prevent the attribute from being
              'set every time the loop executes.
               If Not (GetAttr(fp.sFileRoot) And fp.nChangedAttr) = fp.nChangedAttr Then
            
                  SetAttr fp.sFileRoot, fp.nChangedAttr
                  List1.AddItem fp.sFileRoot
                  fp.cnt = fp.cnt + 1
           
               End If
            End If
            
            fp.checked = fp.checked + 1
            
         End If  'If (WFD.dwFileAttributes
         
     'continue loop until no more matches
      Loop While FindNextFile(hFile, WFD)
      
     'close the handle
      hFile = FindClose(hFile)
   
   End If
   
End Sub


Private Function QualifyPath(sPath As String) As String

  'assures passed path ends in a slash
  
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function
 Comments
Before running, assure that you specify a valid drive, path and filespec in text boxes.

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