100分求高人帮看下代码,文件搜索怎么实现多条件搜索

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

VB code

Option ExplicitPrivate FoundFile() As String '存放传回值的字串阵列Private Ntx As LongPublic 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 = FoundFileEnd FunctionPrivate 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 nIEnd Function

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

探讨

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

[解决办法]
递归部分不用改，只要改判定部分

VB code

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 FunctionPrivate 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 = FalseEnd Function 
 
[解决办法]
还可以考虑调用MSScript.ocx里面VBSCript的正则表达式匹配功能。
[解决办法]
探讨
测试这个搜索还不错 挺快的，就是有时候搜索的文件夹大的话占用cpu会很高，有点可怕
 

 

查看更多 下一篇