VB高速全盘搜索文件,VB高速全盘文件搜索,VB高速搜索全盘文件,VB同时搜索多文件,VB多文件同时搜索,VB高速搜索文件,VB全盘搜索文件,VB高速搜索全盘,VB高速搜索文件,VB同时搜索文件,VB搜索多文件,VB多文件搜索,VB同时搜索,VB文件搜索,VB全盘搜索,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

留言评论(旧系统):

hd @ 2013-09-25 13:18:21

不知道用何种方式判断某个别文件搜索失败。如果我用结果循环判断的话,准确性会降低。

本站回复:

额,代码没考虑这个,只能看搜索结果有没有该文件了……