VB实现文件的快速搜索问题

Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _

                        (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

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 Const INVALID_HANDLE_VALUE = -1

Private Const MaxLFNPath = 260

Private Type FILETIME

        dwLowDateTime As Long

        dwHighDateTime As Long

End Type

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



Dim CurPath As String

Dim DirArray() As String

Dim DirCount As Long

Dim FileArray() As String

Dim FileCount As Long



 

Private Sub Search(CurPath As String, DirArray() As String, DirCount As Long, FileArrary() As String, FileCount As Long)

    Dim hItem As Long

    Dim WFD As WIN32_FIND_DATA

    

    hItem = FindFirstFile(CurPath & "\*.*", WFD)

    If hItem <> INVALID_HANDLE_VALUE Then

        Do

            If (WFD.dwFileAttributes And vbDirectory) Then

                If Asc(WFD.cFileName) <> 46 Then

                    DirCount = DirCount + 1

                    ReDim Preserve DirArray(1 To DirCount)

                    DirArray(DirCount) = CurPath & "\" & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

                    List1.AddItem DirArray(DirCount)

                    Label1.Caption = DirArray(DirCount)

                End If

            Else

               FileCount = FileCount + 1

               ReDim Preserve FileArray(1 To FileCount)

               FileArray(FileCount) = CurPath & "\" & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

               List2.AddItem FileArray(FileCount)

               Label2.Caption = FileArray(FileCount)

            End If

            DoEvents

        Loop While FindNextFile(hItem, WFD)

        Call FindClose(hItem)

    End If

End Sub



Private Sub command1_Click()

CurPath = "c:"

Search CurPath, DirArray(), DirCount, FileArray(), FileCount

Dim i As Long

i = 1

Do While i < DirCount

   CurPath = DirArray(i)

   Search CurPath, DirArray(), DirCount, FileArray(), FileCount

   i = i + 1

Loop

Label1.Caption = "共搜索到" & DirCount & "个文件夹"

Label2.Caption = "共搜索到" & FileCount & "个文件"

End Sub