一个通用的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 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,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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!