VB高速全盘搜索文件，VB同时搜索多文件 -

VB高速全盘搜索文件，VB同时搜索多文件：

Dim Dirlist  As String                                                          '搜索结果列表

Public Function SouYP(N As String)                                              '读取所有硬盘盘符
    On Error Resume Next                                                        '只能强行容错,否则漏掉某个硬盘,导致搜索结果不全
    If N = "" Then Exit Function                                                '如果参数为空则退出
    Dim D
    Dirlist = ""                                                                '清空搜索结果列表
    For Each D In CreateObject("Scripting.FileSystemObject").Drives             'Fso读取磁盘列表
        SouSuo D.DriveLetter & ":\", N                                          '所有硬盘挨个搜索
    Next
    If Dirlist <> "" Then Text1.Text = Dirlist                                  '如果搜索成功,则显示结果
End Function
Public Function SouSuo(ByVal P As String, Optional N As String)                 '路径,关键字(可选)
    On Error Resume Next                                                        '只能强行容错,否则某些特殊目录无法跳过,导致搜索结果不全
    Dim FMuLu() As String, FList As String, i As Long, MuLuSu As Long, Na() As String
    If Right(P, 1) <> "\" Then P = P + "\"                                      '判断最后一位是否为"\",添加"\"防止搜索出错
    FList = Dir(P, vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)   '读取目录列表
    While FList <> ""                                                           '搜索当前目录,直到结果为空
        DoEvents                                                                '转让控制防止卡死
        If (GetAttr(P + FList) And vbDirectory) = vbDirectory Then              '判断属性,如果找到的是目录
            If FList <> "." And FList <> ".." Then                              '排除掉父目录(..)和当前目录(.)
                MuLuSu = MuLuSu + 1                                             '将目录数增1
                ReDim Preserve FMuLu(MuLuSu) As String
                FMuLu(MuLuSu - 1) = FList                                       '用动态数组保存当前目录名
            End If
        Else                                                                    '如果不是目录
            If N = "" Then                                                      '如果关键字为空
                Dirlist = P & FList & vbCrLf & Dirlist                          '则全部输出列表
            Else                                                                '关键字不为空
                Na() = Split(N, "|")                                            '以"|"分割关键字为数组
                For Each X In Na                                                '枚举整个关键字数组Na赋值给X
                    If LCase(FList) = LCase(X) Then Dirlist = P & FList & vbCrLf & Dirlist '转换成小写对比,如果满足搜索条件,则输出结果
                Next
            End If
        End If
        FList = Dir                                                             '继续读取目录列表
    Wend                                                                        '终止循环
    For i = 0 To MuLuSu - 1
        Text1.Text = Dirlist                                                    '显示当前结果
        Text2.Text = P + FMuLu(i)                                               '显示当前进度
        Call SouSuo(P + FMuLu(i), N)                                            '递归搜索子目录
    Next
    ReDim FMuLu(0)                                                              '搜索完成,将动态数组清空
    Exit Function
End Function

Private Sub Command1_Click()
    SouYP ("QQ.exe|uninst.exe|explorer.exe|default.exe|QQ.exe.manifest|Update.exe|hlds.exe|Setup.bat|Setup.exe|name.exe|name.inf") '全硬盘搜索
End Sub

分享到： QQ空间新浪微博腾讯微博微信更多

暂时没有评论

发表评论 - 不要忘了输入验证码哦！

作者：

用户：密码：注册？验证：