用VB API 怎么实现搜索硬盘上的文件 （搜的深，搜的快）

Question

用VB API 怎么实现搜索硬盘上的文件 （搜的深，搜的快）

Answer 1

以前我写得有相关代码以下是关键部分源码:
Option Explicit
'**********************************************************************************************************************
'搜索API函数、常量、类型等声明
Private Const INVALID_HANDLE_VALUE = -1
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private WFD As WIN32_FIND_DATA
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Const MaxLFNPath = 260
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MaxLFNPath
    cShortFileName As String * 14
End Type
'**********************************************************************************************************************
'使LISTBOX滚动条自动下拉等函数及常量声明
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_VSCROLL = &H115
Private Const SB_BOTTOM = 7
'**********************************************************************************************************************
'发送模拟按键消息
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const BM_CLICK = 245
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'**********************************************************************************************************************
'isPause标识是不是处于暂停中,isSearch标识是不是处于文件搜索中,isStop是否处于停止状态
Public isPause As Boolean, isSearch As Boolean, isStop As Boolean
'搜索指定路径并且包括子路径
Public Sub SearcherUserApi(ByVal strCurPath As String, Optional ByVal isCheckSub As Boolean = True)
    Static sum As Long
    If Right(strCurPath, 1) <> "\" Then strCurPath = strCurPath & "\"
    Dim dirs As Long, dirbuf() As String, i As Integer, hItem As Long, k As Long, strTmp As String
    hItem = FindFirstFile(strCurPath & "*.*", WFD)
    If hItem <> INVALID_HANDLE_VALUE Then
        Do
            sum = sum + 1
            If sum Mod 20 = 0 Then DoEvents
            '检查是不是目录
            If (WFD.dwFileAttributes And vbDirectory) Then
                ' 检查是不是  "." or ".."
                If Asc(WFD.cFileName) <> 46 Then
                    ReDim Preserve dirbuf(0 To dirs)
                    dirbuf(dirs) = Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    dirs = dirs + 1
                    strTmp = strCurPath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    frmMain.lstFolders.AddItem strTmp
                    SendMessage frmMain.lstFolders.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
                End If
            Else
                strTmp = strCurPath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                frmMain.lstFiles.AddItem strTmp
                SendMessage frmMain.lstFiles.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
            End If
        Loop While FindNextFile(hItem, WFD)
        Call FindClose(hItem)
    End If
    If Not isCheckSub Then Exit Sub
    For i = 0 To dirs - 1
        If isStop Then isSearch = False: Exit For
        SearcherUserApi strCurPath & dirbuf(i) & "\"
    Next i
End Sub
Public Sub SeacherUserDir(ByVal strPath As String, Optional ByVal isCheckSub As Boolean = True)
    Static sum As Long
    Dim strFolders() As String, dirs As Integer, i As Integer
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    Dim strTmp As String
    On Error Resume Next
    strTmp = Dir(strPath & "*.*", 1 Or 2 Or 4 Or vbDirectory)
    Do While strTmp <> ""
        sum = sum + 1
        If sum Mod 20 = 0 Then DoEvents
        If GetAttr(strPath & strTmp) And vbDirectory Then
            If Left(strTmp, 1) <> "." Then
                frmMain.lstFolders.AddItem strPath & strTmp
                SendMessage frmMain.lstFolders.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
                ReDim Preserve strFolders(0 To dirs)
                strFolders(dirs) = strPath & strTmp & "\"
                dirs = dirs + 1
            End If
        Else
            frmMain.lstFiles.AddItem strPath & strTmp
            SendMessage frmMain.lstFiles.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
        End If
        strTmp = Dir
    Loop
    If Not isCheckSub Then Exit Sub
    For i = 0 To dirs - 1
        If isStop Then isSearch = False: Exit For
        SeacherUserDir strFolders(i), isCheckSub
    Next
End Sub
Public Sub RestorePublic()
    isStop = False
    isPause = False
    isSearch = False
End Sub

Answer 2

或者看这篇文章
也行
http://community.csdn.net/Expert/TopicView.asp?id=5724061

Answer 3

chenhui530(陈辉)  你的代码有问题，不如你把程序发到 谢谢

Answer 4

供参考:http://blog.csdn.net/northwolves/archive/2007/04/10/1558718.aspx