Dim keyWord As String
Dim DirTotal As Double
Dim TimeSpend As Double
Private Sub CmdStart_Click()
ListResult.Clear
ListTemp.Clear
ListTemp.AddItem Trim$(TxtPath.Text)
keyWord = Txtkeyword.Text
DirTotal = 0
Txtout.Text = ""
myFind
End Sub
Public Sub myFind()
Txtout.Text = "正在搜索……"
Dim i As Integer
TimeSpend = Timer
While ListTemp.ListCount > 0
DirTotal = DirTotal + 1
Dir1.Path = ListTemp.List(0)
File1.Path = Dir1.Path
If File1.ListCount > 0 Then
For i = 0 To File1.ListCount - 1
If InStr(File1.List(i), keyWord) > 0 Then
ListResult.AddItem FormatPath(Dir1.Path) & "\" & File1.List(i)
End If
Next
End If
ListTemp.RemoveItem 0
If Dir1.ListCount > 0 Then
For i = 0 To Dir1.ListCount - 1
ListTemp.AddItem Dir1.List(i)
Next
End If
DoEvents
Wend
TimeSpend = Timer - TimeSpend
Txtout.SelStart = Len(Txtout.Text)
Txtout.SelText = "搜索完成!" & vbCrLf & "共找到文件:" & ListResult.ListCount & "个." & vbCrLf & "共搜索目录:" & DirTotal & "个." & vbCrLf & "用时:" & TimeSpend & "毫秒."
End Sub
Private Sub CmdStop_Click()
ListTemp.Clear
End Sub
Private Sub Dir1_Change()
TxtPath.Text = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
ListResult.Clear
ListTemp.Clear
Txtkeyword.Text = ""
Txtout.Text = ""
TxtPath.Text = ""
Dir1_Change
End Sub
Private Sub ListResult_Click()
If ListResult.ListCount > 0 Then TxtFile.Text = ListResult.Text
End Sub
Private Sub TxtPath_Change()
Me.Caption = TxtPath.Text
End Sub
Public Function FormatPath(ByVal thePath As String) As String
thePath = Trim$(thePath)
FormatPath = thePath
If Right$(thePath, 1) = "\" Then FormatPath = Mid$(thePath, 1, Len(thePath) - 1)
End Function
源码及程序 下载地址:
http://www./sr/upload/vb/search.rar
****************[欢迎交流]:********************************
我的百度空间：http:/hi.baidu.com/eli261
我的网易博客：http://eli261.blog.163.com
我的相册:http://eli261.photo.163.com
我的个人主页:http://eli261.
************************************************************ |
|
|
