|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Prerequisites |
Imagehlp.dll for the SearchTreeForFile API methods. On NT this requires version 4.0 or later. On Win9x, this requires Windows 95 or later. The DLL is available as a redistributable for Windows 95x. |
|
The
four methods presents here making use of the FindFirstFile/FindNextFile and SearchTreeForFile APIs provide extremely rapid
searching of the file system for either a specific file, files matching a particular filename or filespec, or folders.
As coded, the routines make use of a compact User-Defined Type for passing the search parameters to the routines and receiving the results, similar to the method used by popular APIs (including the FindXXX methods here). This UDT technique provides for extending the capabilities of a routine by simply adding a new member to the UDT and coding for it. The four methods shown can be broken into two categories. The first two methods - "Search for Files" and "Search for Folders" - use the FindFirst/FindNextFile APIs available on all Win32 systems to search within a tight loop for a specified filename/extension on the target path. The last two methods -"Search Drive for File" and "Search System for File" - use the SearchTreeForFile API, available when the newer imagehlp.dll libraries are installed, typically as part of an operating system upgrade. SearchTreeForFile takes a base (initial root) folder and searches the under that folder drive for file matching the filename specified, returning its full location. The "Search System for File" method also makes use of GetLogicalDriveStrings to allow full-system (multi-drive) searching across both local and mapped network drives. The GetLogicalDriveStrings method could be easily added to the FindFirst methods to perform a similar system-wide search using those APIs instead. There is a primary difference between the FindFirst and SearchTreeForFile methodologies. SearchTreeForFile methods return only the first single file matching an exact filespec criteria, and does not accept wildcards in the search. This limitation is not present in the FindXXX methods. FindFirstFile, on successfully locating a file or folder satisfying the initial filespec criteria, returns a handle to be used for subsequent calls by its corresponding FindNextFile API. The data of each retrieved folder or file is returned in each call wrapped in a WIN32_FIND_DATA structure. The dwFileAttributes member of WIN32_FIND_DATA can be used to determine if the returned item is a file or folder when AND'd with the VB (or WinAPI) constant vbDirectory. When "No Listing" is unchecked, the routines populate a listbox with retrieved data. Commends below indicate show how easily the code could be changed to instead populate an array or collection, or to create a file location mechanism when a partial filename / file spec was provided. When "No Listing" is selected, the FindXXX methods skip populating the listbox providing an extremely rapid file counting / file size / file locating mechanism. The default mode coded is to search only the specified folder. When the "Recurse" button is checked, the specified folder, and all subfolders under it are searched. When a drive is specified as the source path, the recursion searches all folders on the drive. 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: three text boxes (Text1, Text2, Text3), a combo box (Combo1), and four command buttons (Command1 - Command4). In addition, add two check boxes (Check1 and Check2). Finally, add a listbox (List1), label as desired, and add the following code: |
|
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 MAXDWORD As Long = &HFFFFFFFF 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 As Long = &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 = 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 'custom UDT for searching - add additional members if required 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, ie c:\, c:\winnt\ sFileNameExt As String 'filename/filespec to locate, ie *.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 SearchTreeForFile Lib "imagehlp" _ (ByVal sFileRoot As String, _ ByVal InputPathName As String, _ ByVal OutputPathBuffer As String) As Boolean 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 "*.ini" .AddItem "*.ocx" .AddItem "*.vxd" .ListIndex = 0 End With End Sub Private Sub Command1_Click() Dim FP As FILE_PARAMS Call DisplayInit With FP .sFileRoot = Text1.Text .sFileNameExt = Combo1.Text .bRecurse = Check1.Value = 1 .bList = Check2.Value = 0 End With Call SearchForFiles(FP) Call DisplayResults(FP) End Sub Private Sub Command2_Click() Dim FP As FILE_PARAMS Call DisplayInit With FP .sFileRoot = Text1.Text .sFileNameExt = "*.*" .bRecurse = Check1.Value = 1 .bList = Check2.Value = 0 End With Call SearchForFolders(FP) Call DisplayResults(FP) End Sub Private Sub Command3_Click() Dim FP As FILE_PARAMS Call DisplayInit With FP .sFileRoot = "c:\" .sFileNameExt = "wordpad.exe" End With Call SearchPathForFile(FP) Call DisplayResults(FP) End Sub Private Sub Command4_Click() Dim FP As FILE_PARAMS Call DisplayInit With FP .sFileRoot = "c:\" .sFileNameExt = "vb6.exe" End With Call SearchSystemForFile(FP) Call DisplayResults(FP) End Sub Private Sub DisplayInit() 'common routine to initialize display Text2.Text = "Working ..." Text3.Text = "" Text2.Refresh Text3.Refresh List1.Clear List1.Visible = False End Sub Private Sub DisplayResults(FP As FILE_PARAMS) 'a common routine to display search results 'this defaults to show the size and count 'containing in the FP type members, but if 'FP.sResult is filled (from the Drive and 'System search methods), that is shown instead. Text2.Text = Format$(FP.nFileCount, "###,###,###,##0") & _ & " found (" & FP.sFileNameExt & ")" Text3.Text = Format$(FP.nFileSize, "###,###,###,###,###,###,##0") & " bytes" If Len(FP.sResult) > 0 Then Text2.Text = "found: " & FP.bFound Text3.Text = "location: " & FP.sResult End If List1.Visible = True 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 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 Function GetFileInformation(FP As FILE_PARAMS) As Long 'local working variables Dim WFD As WIN32_FIND_DATA Dim hFile As Long Dim nSize 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 'remove trailing nulls sTmp = TrimNull(WFD.cFileName) '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 'file found, so increase the file count FP.nFileCount = FP.nFileCount + 1 'retrieve the size and assign to nSize to 'be returned at the end of this function call nSize = nSize + (WFD.nFileSizeHigh * (MAXDWORD + 1)) + WFD.nFileSizeLow 'add to the list if the flag indicates If FP.bList Then List1.AddItem sRoot & sTmp End If Loop While FindNextFile(hFile, WFD) 'close the handle hFile = FindClose(hFile) End If 'return the size of files found GetFileInformation = nSize End Function Private Function SearchPathForFile(FP As FILE_PARAMS) As Boolean Dim sResult As String 'pad a return string and search the passed drive sResult = Space(MAX_PATH) 'SearchTreeForFile returns True (1) if found, 'or False otherwise. If True, sResult holds 'the full path. FP.bFound = SearchTreeForFile(FP.sFileRoot, FP.sFileNameExt, sResult) 'if found, strip the trailing nulls and exit If FP.bFound Then FP.sResult = LCase$(TrimNull(sResult)) End If SearchPathForFile = FP.bFound End Function Private Function SearchSystemForFile(FP As FILE_PARAMS) As Boolean Dim nSize As Long Dim sBuffer As String Dim currDrive As String Dim sResult As String 'retrieve the available drives on the system sBuffer = Space$(64) nSize = GetLogicalDriveStrings(Len(sBuffer), sBuffer) 'nSize returns the size of the drive string If nSize Then 'strip off trailing nulls sBuffer = Left$(sBuffer, nSize) 'search each fixed disk 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 'pad a return string and search the passed drive sResult = Space(MAX_PATH) FP.bFound = SearchTreeForFile(FP.sFileRoot, FP.sFileNameExt, sResult) 'if found, strip the trailing nulls and exit If FP.bFound Then FP.sResult = LCase$(TrimNull(sResult)) Exit Do End If End If Loop End If SearchSystemForFile = FP.bFound End Function Private Function SearchForFiles(FP As FILE_PARAMS) As Double 'local working variables Dim WFD As WIN32_FIND_DATA Dim hFile As Long Dim nSize As Long Dim sPath As String Dim sRoot As String Dim sTmp As String 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. ' 'GetFileInformation function returns the size, 'in bytes, of the files found matching the 'filespec in the passed folder, so it is 'assigned to nSize. It is not directly assigned 'to FP.nFileSize because nSize is incremented 'below if a recursive search was specified. nSize = GetFileInformation(FP) FP.nFileSize = nSize Do 'if the returned item is a folder... If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then '..and the Recurse flag was specified If FP.bRecurse 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 '..then the item is a real folder, which 'may contain other sub folders, so assign 'the new folder name to FP.sFileRoot and 'recursively call this function again with 'the ammended information. ' 'Since nSize is a local variable, whose value 'is both set above as well as returned as the 'function call value, the nSize needs to be 'added to previous calls in order to maintain accuracy. ' 'However, because the nFileSize member of 'FILE_PARAMS is passed back and forth through 'the calls, nSize is simply assigned to it 'after the recursive call finishes. FP.sFileRoot = sRoot & sTmp nSize = nSize + SearchForFiles(FP) FP.nFileSize = nSize End If 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 'because this routine is recursive, return 'the size of matching files SearchForFiles = nSize End Function Private Function SearchForFolders(FP As FILE_PARAMS) As Long Dim WFD As WIN32_FIND_DATA Dim hFile As Long Dim sRoot As String Dim sPath As String Dim sTmp As String Dim nCount As Long sRoot = QualifyPath(FP.sFileRoot) sPath = sRoot & FP.sFileNameExt 'obtain handle to the first match hFile = FindFirstFile(sPath, WFD) 'if valid ... If hFile <> INVALID_HANDLE_VALUE Then Do 'We only want folders in this method. If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then 'remove trailing nulls sTmp = TrimNull(WFD.cFileName) 'and if not the default system folders If sTmp <> "." And sTmp <> ".." Then 'count it and add to the list if the flag indicates nCount = nCount + 1 If FP.bList Then List1.AddItem sRoot & sTmp 'if a recursive search was selected, call 'this method again with a modified root If FP.bRecurse Then FP.sFileRoot = sRoot & sTmp nCount = nCount + SearchForFolders(FP) End If 'this is outside the recurse code in case 'a single path-search was specified FP.nFileCount = nCount End If End If Loop While FindNextFile(hFile, WFD) 'close the handle hFile = FindClose(hFile) End If 'since folders are 0-length, return the count instead SearchForFolders = nCount End Function |
Comments |
Before running, assure that any hard-coded paths in the
Command button events reflect accurate paths on your system.
Since this example uses the listbox to return the results, on systems containing many files you may eventually hit the listbox item limit of 32k items. While there is no practical or reliable way to extend the number of items a listbox can contain (without resorting to an owner-drawn control), you can increase the number of files read (if exceeding the size of a Long), by declaring the appropriate variables as Currency instead. 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). |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |