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

最新推荐文章于 2023-12-28 02:00:25 发布

miaozk2006

最新推荐文章于 2023-12-28 02:00:25 发布

阅读量165

点赞数

本文链接：https://blog.csdn.net/miaozk2006/article/details/82422207

版权

磁盘文件搜索是一件比较简单的事情，但很多代码写得非常繁琐，而且不支持多重路径和文件通配符，为此，我用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, 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