100分求高人帮看下代码,文件搜索如何实现多条件搜索?

    我下面贴的这个坛子里高人老马写的函数已经能实现搜索指定文件夹下的文件,而且支持通配符.但是不能多条件搜索,也就是每次只能搜索一个条件,比如 jieguo = SearchFileInPath("c:\", "项目*.txt"),但我想实现的是比如搜索"项目*.txt" 或者 "*旅游.*".
    也就是希望能实现jieguo = SearchFileInPath("c:\", "项目*.txt" or "*旅游.*").
    下面这个代码如果我想搜这两个条件的话我不得不运行两次搜索,两个条件各运行一次,这样的效率就很低.怎么实现多条件搜呢?想不出来了.
    条件定义我只要OR就可以了(可能很多个条件,也就是多个OR).AND或者更复杂的之类都不用了.谢谢!

Option Explicit
Private FoundFile() As String '存放传回值的字串阵列
Private Ntx As Long

Public Function SearchFileInPath(ByVal thePath As String, ByVal theFileName As String, Optional ByVal mStop As Boolean = False) As String()
If Right(thePath, 1) <> "\" Then thePath = thePath & "\"
    Call GetFileLoop(thePath, theFileName, mStop)
    SearchFileInPath = FoundFile
End Function

Private Function GetFileLoop(CurrentPath As String, ByVal SearFile As String, Optional ByVal mStop As Boolean = False) As String
    Dim nI As Integer, nDirectory As Integer, i As Long
    Dim sFileName As String, sDirectoryList() As String
  ' Ntx = 0
    On Error Resume Next
    sFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)
    Do While sFileName <> ""
        If UCase(sFileName) Like UCase(SearFile) Then
            i = GetAttr(CurrentPath + sFileName)
            If (i And vbDirectory) = 0 Then
                If mStop = False Then
                    ReDim Preserve FoundFile(Ntx)
                    FoundFile(Ntx) = CurrentPath + sFileName
                    Ntx = Ntx + 1
                Else
                    GetFileLoop = CurrentPath + sFileName
                    Exit Function
                End If
            End If
        End If
        If sFileName <> "." And sFileName <> ".." Then
            If GetAttr(CurrentPath & sFileName) _
            And vbDirectory Then
                
                nDirectory = nDirectory + 1
                ReDim Preserve sDirectoryList(nDirectory)
                sDirectoryList(nDirectory) = CurrentPath & sFileName
            End If
        End If
        sFileName = Dir
    Loop
    For nI = 1 To nDirectory
         GetFileLoop = GetFileLoop(sDirectoryList(nI) & "\", SearFile)
         If GetFileLoop <> "" And mStop = True Then Exit For
    Next nI
End Function

12 个解决方案

#1

使用正则。
可以支持更多条件。
使用时用|连接即可。

#2

正则我更不会了,厚脸皮一下,能求下代码吗?多谢!

#3

Dir() 函数只支持单个条件，如果要多条件，有两种方法：
A)每个条件单独搜索一次，然后合并结果。
B)整体用 *.* 条件遍历，对每个文件名进行多条件判断——可以用正则、也可以简单地循环用 Like 操作符判断。

#4

引用楼主 vvsuc189881 的回复:

我下面贴的这个坛子里高人老马写的函数已经能实现搜索指定文件夹下的文件,而且支持通配符.但是不能多条件搜索,也就是每次只能搜索一个条件,比如 jieguo = SearchFileInPath("c:\", "项目*.txt"),但我想实现的是比如搜索"项目*.txt" 或者 "*旅游.*".
  也就是希望能实现jieguo = SearchFileInPath("c:\", "项目*.txt"……

用江南春这个：VB磁盘文件搜索引擎类（支持多条件）
http://blog.csdn.net/lyserver/article/details/4397098

#5

引用 4 楼 chenjl1031 的回复:

用江南春这个：VB磁盘文件搜索引擎类（支持多条件）
http://blog.csdn.net/lyserver/article/details/4397098

多谢大侠!都是高人,膜拜!
去测试下,不知道速度效率怎么样.
谢谢!

#6

引用 3 楼 tiger_zhao 的回复:

Dir() 函数只支持单个条件，如果要多条件，有两种方法：
A)每个条件单独搜索一次，然后合并结果。
B)整体用 *.* 条件遍历，对每个文件名进行多条件判断——可以用正则、也可以简单地循环用 Like 操作符判断。

谢谢!我试了下用多个like,但是还没搞定,那个这里:应该要对多个SearFile类型多重循环,但是我自己改的测试不对

    For nI = 1 To nDirectory
         GetFileLoop = GetFileLoop(sDirectoryList(nI) & "\", SearFile)
         If GetFileLoop <> "" And mStop = True Then Exit For
    Next nI

#7

递归部分不用改，只要改判定部分

Private Function GetFileLoop(CurrentPath As String, ByVal SearFile As String, Optional ByVal mStop As Boolean = False) As String
    ...
    Do While sFileName <> ""
        'If UCase(sFileName) Like UCase(SearFile) Then <- 修改为
        If IsMatch(FileName, SearFile) Then
    ...
End Function

Private Function IsMatch(ByVal FileName As String, ByVal SearchPattern As String) As Boolean
    Dim aPatterns() As String
    Dim I As Long
    
    aPatterns = Split(SearchPattern, ";") '约定用分号连接多个条件，比如：*.txt;*旅游.*
    For I = 0 To UBound(aPatterns)
        If FileName Like aPatterns(I) Then
            IsMatch = True
            Exit Function
        End If
    Next
    
    IsMatch = False
End Function

最多优化一下，将 aPatterns() 变成模块级变量，让 Split 只做一次。

#8

引用 7 楼 tiger_zhao 的回复:

递归部分不用改，只要改判定部分

VB code

Private Function GetFileLoop(CurrentPath As String, ByVal SearFile As String, Optional ByVal mStop As Boolean = False) As String
    ...
    Do While sFileName <> ""
 ……

多谢！这个应该可以了，我去测试下，谢谢！！

#9

测试这个搜索还不错 挺快的，就是有时候搜索的文件夹大的话占用cpu会很高，有点可怕

#10

还可以考虑调用MSScript.ocx里面VBSCript的正则表达式匹配功能。

#11

引用 9 楼 vvsuc189881 的回复:

测试这个搜索还不错 挺快的，就是有时候搜索的文件夹大的话占用cpu会很高，有点可怕

遍历文件目录这是免不了的，反正现在都是多核CPU，程序最多只占用 1/n 的 CPU 资源。

#12

引用 11 楼 tiger_zhao 的回复:

引用 9 楼 vvsuc189881 的回复:测试这个搜索还不错 挺快的，就是有时候搜索的文件夹大的话占用cpu会很高，有点可怕
遍历文件目录这是免不了的，反正现在都是多核CPU，程序最多只占用 1/n 的 CPU 资源。

可能是免不了.我测试双核的,还是会假死