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

[hjker007]

参考网上的利用API实现文件的搜索的代码，写了如下的程序

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

问题：
1，各位高手帮忙看看能够提高一下效率呢？
2，我想以FileArray作为基础数据，比如存入数据库，然后在此基础上进行用户要求的搜索，FileArray的数据结构该如何建立？（还按照现在的数组形式肯定效率低了）
3，想实现对计算机文件的监控，主要监控产生了哪些新文件，哪些文件发生改变了（主要指文件类型），这样能够及时修改第2条中的基础数据，以便能实现用户的搜索要求。

各位帮忙启发下思路吧，谢谢！

[hjker007]

自己顶顶

[xmcai123]

你也在搞分吧

[proer9988]

'我修改了一段代码，查找速度似乎比你这个快，你测试一下
Option Explicit

Dim ctStop As Boolean, ctS As Long, ctCi As Long


Private Sub Form_Load()
Command1.Caption = "查找": Command2.Caption = "停止"
End Sub

Private Sub Form_Unload(Cancel As Integer)
ctStop = True
End Sub

Private Sub Command1_Click()
List1.Clear
ctStop = False: ctS = 0
'Call FileAll(App.Path) '显示 当前文件夹下的所有文件

MsgBox FileAll("F:\第二轮实验与实践管理科")

End Sub

Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ctStop = True
End Sub

Private Function FileAll(ByVal nPath As String) As Long 'String
'返回当前文件夹及以下的所有子文件夹中文件，修改自网络上的某人程序
Dim nName As String, nPathS() As String, IsPath As Boolean
Dim nCount As Long, s As Long, i As Long
Static strXLS As String
Static ii As Long

If ctStop Then Exit Function

On Error Resume Next
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
nName = Dir(nPath & "*", 23)
Do
ctCi = ctCi + 1
If ctCi > 100 Then
ctCi = 0
Label1.Caption = "找到:" & ctS & " " & nPath


DoEvents
If ctStop Then Exit Function
End If

If nName = "" Then Exit Do
If nName <> "." And nName <> ".." Then
IsPath = False
IsPath = GetAttr(nPath & nName) And vbDirectory
If IsPath Then
'记忆当前目录下的所有下级目录，这是实现递归调用的关键

s = s + 1
ReDim Preserve nPathS(1 To s)
nPathS(s) = nPath & nName
Else
'List1.AddItem nPath & nName
ctS = ctS + 1
ii = ii + 1
'Debug.Print nPath & nName
' If UCase(Right$(nPath & nName, 3)) = "XLS" Then
' strXLS = strXLS & nPath & nName & ","
' End If
'Debug.Print strXLS
End If
End If
nName = Dir()
Loop
'Label1.Caption = "找到:" & ctS & " " & nPath
'Label1.Refresh
For i = 1 To s
Call FileAll(nPathS(i)) '递归调用

Next
Erase nPathS
' If Right(strXLS, 1) = "," Then
' strXLS = Left(strXLS, Len(strXLS) - 1)
' End If
FileAll = ii 'strXLS
End Function

[lyserver]

参考《一个通用的VB磁盘文件搜索引擎类》

[hjker007]

lyserver的这段代码比较清晰，方法应该还是一样的。非常感谢！


3，想实现对计算机文件的监控，主要监控产生了哪些新文件，哪些文件发生改变了（主要指文件类型）


各位高手，这个如何实现呢？

[lyserver]

Private Declare Function FindFirstChangeNotification Lib "kernel32" Alias "FindFirstChangeNotificationA" (ByVal lpPathName As String, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long) As Long
Private Declare Function FindCloseChangeNotification Lib "kernel32" (ByVal hChangeHandle As Long) As Long
Private Declare Function FindNextChangeNotification Lib "kernel32" (ByVal hChangeHandle As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

[hjker007]

各位高手，如何提高文件搜索的效率阿？？？

现在发现搜索没有问题了，但出了个新问题，搜索文件数量很大时，如何过滤掉其中的重名文件？？？

急等！！！！