| 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 |
| 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). |
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.
