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

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

Option Explicit '* ************************************************** * '* 程序名称：FileFindEngine.bas '* 程序功能：磁盘文件搜索引擎类 '* 支持多重路径和文件通配符 '* 作者：lyserver '* 联系方式：http://blog.youkuaiyun.com/lyserver '* ************************************************** * 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 Private 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 * 14 End Type Private Const INVALID_HANDLE_VALUE = -1 Public Event Found(ByVal FileName As String, Cancel As Boolean) Public Event Complete() Dim m_Cancel As Boolean, m_Count As Long Public 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 Function Private 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 hFindFile End Sub

    测试代码如下：

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