一个通用的VB磁盘文件搜索引擎类

    磁盘文件搜索是一件比较简单的事情，但很多代码写得非常繁琐，而且不支持多重路径和文件通配符，为此，我用VB写了一个通用的磁盘文件搜索引擎类，类代码如下：

Option Explicit'* ************************************************** *'* 程序名称：FileFindEngine.bas'* 程序功能：磁盘文件搜索引擎类'* 支持多重路径和文件通配符'* 作者：lyserver'* 联系方式：http://blog.csdn.net/lyserver'* ************************************************** *Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As LongPrivate Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As Currency ftLastAccessTime As Currency ftLastWriteTime As Currency nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * 260 cAlternate As String * 14End TypePrivate Const INVALID_HANDLE_VALUE = -1Public Event Found(ByVal FileName As String, Cancel As Boolean)Public Event Complete()Dim m_Cancel As Boolean, m_Count As LongPublic Function Find(ByVal strPath As String, Optional ByVal strFile As String, Optional ByVal LookInSubFolder As Boolean = True) As Boolean Dim i As Long Dim strPaths() As String, strFiles() As String On Error GoTo ErrHandle strPaths = Split(LCase(Trim(strPath)), ";") strFiles = Split(LCase(Trim(strFile)), ";") m_Count = UBound(strFiles) For i = 0 To UBound(strPaths) FindProc strPaths(i), strFiles, LookInSubFolder Next ErrHandle: m_Cancel = False RaiseEvent Complete Find = (Err.Number = 0)End FunctionPrivate Sub FindProc(ByVal strPath As String, strFiles() As String, ByVal LookInSubFolder As Boolean) Dim wfd As WIN32_FIND_DATA Dim FileName As String, FullFileName As String, LCaseFileName As String Dim i As Long, hFindFile As Long '处理目标路径 If Right(strPath, 1) <> "/" Then strPath = strPath & "/" '根据文件适配符查找文件 hFindFile = FindFirstFile(strPath & "*.*", wfd) Do While hFindFile <> INVALID_HANDLE_VALUE FileName = Left(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1) If FileName <> "." And FileName <> ".." Then FullFileName = strPath & FileName If wfd.dwFileAttributes And vbDirectory Then If LookInSubFolder And (Not m_Cancel) Then FindProc FullFileName, strFiles, LookInSubFolder If m_Cancel Then Exit Do End If Else LCaseFileName = LCase(FileName) For i = 0 To m_Count If LCaseFileName = strFiles(i) Or LCaseFileName Like strFiles(i) Then RaiseEvent Found(FullFileName, m_Cancel) Exit For End If Next If m_Cancel Then Exit Do End If End If If FindNextFile(hFindFile, wfd) = 0 Then Exit Do Loop FindClose hFindFileEnd Sub

    测试代码如下：

Option ExplicitDim WithEvents o As FileFindEnginePrivate Sub Command1_Click() o.Find "C:/;D:/", "metaback.vbs;*.txt"End SubPrivate Sub Form_Load() Set o = New FileFindEngineEnd SubPrivate Sub o_Complete() MsgBox "搜索完毕"End SubPrivate Sub o_Found(ByVal FileName As String, Cancel As Boolean) Debug.Print FileName 'Cancel = TrueEnd Sub