findfiles.txt

使用递归算法在指定目录下查找文件.good 我找了很长时间的

***************************************************************
*  Go to Dragon's VB Code Corner for more useful sourcecode:  *
*  http://personal.inet.fi/cool/dragon/vb/                    *
***************************************************************

Author: Dragon <[e-mail]>

Here is a recursive routine to search for files. Features include starting from specified
dir, and patter matching of both file and dir. For info on usage please see beginning of 
routine.


Put the following code in a bas module
'//*********************************//'
Public Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

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

Public Sub FindFiles(strRootFolder As String, strFolder As String, strFile As String, colFilesFound As Collection)
    
   '*********************************************************
   '* Author: Dragon <[e-mail]>          *
   '*         http://personal.inet.fi/cool/dragon/vb/       *
   '*                                                       *
   '* Last updated: August 14, 1998                         *
   '*                                                       *
   '* This recursive routine searches for a specified       *
   '* file/files starting from a specified rootfolder       *
   '* You can specify folder and file info with pattern     *
   '* matching (*, ?, # and so on). For more info on        *
   '* pattern matching please refer to the VB documentation *
   '* for the 'Like' function                               *
   '*                                                       *
   '* This function has the following arguments:            *
   '*                                                       *
   '*   strRootFolder  =  the folder from which the search  *
   '*                     starts. The search will only find *
   '*                     files in this directory or it's   *
   '*                     subdirectories                    *
   '*                                                       *
   '*   strFolder = folder information for the files        *
   '*               searched. Specify * to allow files in   *
   '*               any folder. Pattern matching allowed.   *
   '*                                                       *
   '*   strFile = the filename to search for. Pattern       *
   '*             matching allowed.                         *
   '*                                                       *
   '*   colFilesFound = the files found will be placed in   *
   '*                   this collection                     *
   '*                                                       *
   '* Example usage:                                        *
   '* Dim colFiles as New Collection 'Note 'New' keyword!!  *
   '* Call FindFiles("C:\Windows\System","*","doc[123].txt")*
   '*                                                       *
   '* Then colFiles will be filled with all the text files  *
   '* named doc1.txt or doc2.txt or doc3.txt in the Windows\*
   '* System dir and all it's subdirs.                      *
   '*                                                       *
   '*********************************************************

    Dim lngSearchHandle As Long
    Dim udtFindData As WIN32_FIND_DATA
    Dim strTemp As String, lngRet As Long
        
    'Check that folder name ends with "\"
    If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"
    
    'Find first file/folder in current folder
    lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
    
    'Check that we received a valid handle
    If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Sub
    
    lngRet = 1
    
    Do While lngRet <> 0
        
        'Trim nulls from filename
        strTemp = TrimNulls(udtFindData.cFileName)
        
        If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            'It's a dir - make sure it isn't . or .. dirs
            If strTemp <> "." And strTemp <> ".." Then
                'It's a normal dir: let's dive straight
                'into it...
                Call FindFiles(strRootFolder & strTemp, strFolder, strFile, colFilesFound)
            End If
        Else
            'It's a file. First check if the current folder matches
            'the folder path in strFolder
            If (strRootFolder Like strFolder) Then
                'Folder matches, what about file?
                If (strTemp Like strFile) Then
                    'Found one!
                    colFilesFound.Add strRootFolder & strTemp
                End If
            End If
        End If
        
        'Get next file/folder
        lngRet = FindNextFile(lngSearchHandle, udtFindData)
        
    Loop
    
    'Close find handle
    Call FindClose(lngSearchHandle)
    
End Sub

Public Function TrimNulls(strString As String) As String
   
   Dim l As Long
   
   l = InStr(1, strString, Chr(0))
   
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(strString, l - 1)
   Else
      TrimNulls = strString
   End If
   
End Function