|
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 |