当前位置: 开源爱好者 » 编程教程 » VB教程 » 正文

VB 超快速的搜索电脑文件一例

这个代码不是最新的,但在前几年是一种比较流行的快速搜索文件的方法,代码中使用了封装方法,运行效果如下图示:

 Visual basic 6.0 超快速的搜索电脑文件一例

相关代码分享如下:

Dim ahwnd As String '声明变量
Dim Find As WIN32_FIND_DATA, hi&, hf&
Dim x, y As Integer, Dir$, f As Boolean
Private Sub Form_Load()
    ahwnd = List1.hwnd ' 窗口的句柄
    SendMessage ahwnd, LB_INITSTORAGE, 30000&, ByVal 30000& * 200 '调用窗口函数
End Sub
Private Sub Form_Activate()
    Dir1.Path = App.Path '设定默认路径
    Drive1.Drive = Left(Dir1.Path, 3)
End Sub
Private Sub Dir1_Change()
    Text1.Text = Dir1.Path & "\" '选择文件夹
End Sub
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive '选择驱动器
End Sub
Private Sub Search(file$)
    Dim n, i As Integer
    Dim ss()
    DoEvents      '交控制权
    If Not f Then Exit Sub
    hi& = FindFirstFile(file$ & "*.*", Find)     '查找文件
    If hi& <> INVALID_HANDLE_VALUE Then
        Do
            If (Find.dwFileAttributes And vbDirectory) Then   '目录级查找
                If Asc(Find.cFileName) <> 46 Then
                    x = x + 1
                    If (n Mod 10) = 0 Then ReDim Preserve ss(n + 10)  '扩充数组
                    n = n + 1
                    ss(n) = Left$(Find.cFileName, InStr(Find.cFileName, vbNullChar) - 1)
                End If
            Else
                y = y + 1
            End If
        Loop While FindNextFile(hi&, Find)
        Call FindClose(hi&)      '关闭FindFirstFile
    End If
    SendMessage ahwnd, WM_SETREDRAW, 0, 0  '消息窗口
    hf& = FindFirstFile(file$ & Dir$, Find)
    If hf& <> INVALID_HANDLE_VALUE Then '查找文件
        Do
            DoEvents
            If Not f Then Exit Sub
            SendMessage ahwnd, LB_ADDSTRING, 0, ByVal file$ & Left$(Find.cFileName, InStr(Find.cFileName, vbNullChar) - 1)
        Loop While FindNextFile(hf&, Find)    '调用函数
        Call FindClose(hf&)
    End If
    SendMessage ahwnd, WM_VSCROLL, SB_BOTTOM, 0
    SendMessage ahwnd, WM_SETREDRAW, 1, 0
    For i = 1 To n
       Search file$ & ss(i) & "\" '调用查找函数
    Next i
End Sub

Private Sub Text1_Change()
    If Len(Text1.Text) = 4 Then Text1.Text = Left(Text1.Text, 3)   '去掉路径中的\
End Sub
Private Sub Command1_Click()   '查找文件
    On Error Resume Next
    If f Then: f = False: Exit Sub
    Dir$ = Combo1.Text
    MousePointer = 11
    f = True
    List1.Clear      '清空列表
    If f Then Call Search(Text1.Text)  '调用函数查找文件
   ' Label1.Caption = "文件个数: " & List1.ListCount & " 个"
    f = False
    MousePointer = 0
End Sub

 完整代码请下载:VB高速文件搜索程序

CopyRight 2018© 开源爱好者 All Rights Reserved 豫ICP备16030607号 隐私声明 网站地图