VB 100分求 解决 查找文件的问题

Question

递归查找文件,到2级目录就返回不继续查找例如要查找 E:\ABC\下的1.exe文件
E:\ABC\下的文件及其文件夹如下：E:\ABC\BASD\SADFS\SDF\SDFSA\...
E:\ABC\SADF\SEWE\WEWE\WW\...
E:\ABC\ASDFAS\SASSS\SSSE\SAA...如果E:\ABC\一级目录\二级目录\ 下都未发现1.exe的情况下，不递归到E:\ABC\一级目录\二级目录\三级目录\查找换句话说就是1.exe会出现的位置在
E:\ABC\BASD\1.exe
E:\ABC\BASD\SADFS\1.exe
E:\ABC\SADF\1.exe
E:\ABC\SADF\SEWE\1.exe
E:\ABC\ASDFAS\1.exe
E:\ABC\ASDFAS\SASSS\1.exe为了节约查找时间，如果递归到2级目录内时仍未查找到文件就不递归到3级目录了。也就是如果E:\ABC\BASD\和E:\ABC\BASD\SADFS\目录都没有就不再搜索E:\ABC\BASD\SADFS\SDF\目录和E:\ABC\BASD\SADFS\SDF\SDFSA\而是搜索E:\ABC\SADF\目录依次递归。网上的代码都是递归所有目录下的子目录和文件，有点浪费时间。忘高人帮忙。谢谢。窗体代码:
Option ExplicitDim FileSpec$, UseFileSpec%
Dim TotalDirs%, TotalFiles%, Running%
Dim WFD As WIN32_FIND_DATA, hItem&, hFile&
Const vbBackslash = "\"
Const vbAllFiles = "*.*"
Const vbKeyDot = 46Private Sub Command1_Click()
On Error Resume Next
    Running% = True
    UseFileSpec% = True
    FileSpec$ = "1.exe"      Call SearchDirsB("E:\ABC\")
    Picture1.Cls
    Picture1.Print "查找完成!"
End Sub
Private Sub SearchDirsB(curpath$) '文件夹
 Dim dirs%, dirbuf$(), i%
    Picture1.Cls
    Picture1.Print curpath$
    DoEvents
    If Not Running% Then Exit Sub
    hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
    If hItem& <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And vbDirectory) Then
                If Asc(WFD.cFileName) <> vbKeyDot Then
                    TotalDirs% = TotalDirs% + 1
                    If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
                    dirs% = dirs% + 1
                    dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                End If
            ElseIf Not UseFileSpec% Then
                TotalFiles% = TotalFiles% + 1
            End If
        Loop While FindNextFile(hItem&, WFD)
        Call FindClose(hItem&)
    End If
    If UseFileSpec% Then
        Call SearchFileSpecB(curpath$)
    End If
    For i% = 1 To dirs%
         SearchDirsB curpath$ & dirbuf$(i%) & vbBackslash
    Next i%
End Sub
Private Sub SearchFileSpecB(curpath$) '文件夹
Dim PathName As String
    hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)
    If hFile& <> INVALID_HANDLE_VALUE Then
        Do
            DoEvents
            If Not Running% Then Exit Sub
            PathName = curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
             
                     Text1.Text = PathName
                     Running% = False
                     UseFileSpec% = False
              
        Loop While FindNextFile(hFile&, WFD)
        
        Call FindClose(hFile&)
    
    End If
End Sub模块代码：
Option ExplicitDeclare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Const INVALID_HANDLE_VALUE = -1
Public Const MaxLFNPath = 260Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
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

Answer 1

200分求解，另100分 http://topic.csdn.net/u/20090815/02/a8bee62f-4429-4584-8520-f62d897a9404.html

Answer 2

可以这样:
SearchDirsB加两个参数,一个是当前深度,一个是总深度.
递归调用之前,判断深度是否已经到达总深度,如果到达,就不再递归调用了.
如果没有到达总深度,就递归调用,将当前深度加1.

Answer 3

Private Sub SearchDirsB(curpath$) '文件夹
Dim dirs%, dirbuf$(), i%
Dim depth% '加个路径深度做判断是否退出查找用
  
  If curpath$ = "" Then MsgBox "路径错误", 64: Exit Sub
  
  depth = UBound(Split(curpath$, "\")) - 2
    
    Picture1.Cls
    Picture1.Print curpath
    DoEvents
    If depth > 2 Then
      Picture1.Print "如果递归到2级目录内时仍未查找到文件就不递归到3级目录了"
      Exit Sub
    End If
    If Not Running% Then Exit Sub
    hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
    If hItem& <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And vbDirectory) Then
                If Asc(WFD.cFileName) <> vbKeyDot Then
                    TotalDirs% = TotalDirs% + 1
                    If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
                    dirs% = dirs% + 1
                    dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                End If
            ElseIf Not UseFileSpec% Then
                TotalFiles% = TotalFiles% + 1
            End If
        Loop While FindNextFile(hItem&, WFD)
        Call FindClose(hItem&)
    End If
    If UseFileSpec% Then
        Call SearchFileSpecB(curpath$)
    End If
    For i% = 1 To dirs%
        SearchDirsB curpath$ & dirbuf$(i%) & vbBackslash
    Next i%
End Sub

Answer 4

直接用 VB 本身的功能即可实现
Option ExplicitFunction SearchDirsB(ByVal Path As String, _
                     ByVal File As String, _
                     ByVal Level As Long _
                    ) As Boolean
    Dim sFound As String
    Dim oSubDirs As Collection
    
    Picture1.Cls
    Picture1.Print curpath$
    DoEvents
    
    sFound = Dir$(Path & File)
    If StrComp(sFound, File, vbTextCompare) = 0 Then
        Text1.Text = Path & sFound
        SearchDirsB = True
        Exit Function
    End If    If Level > 1 Then
        Set oSubDirs = New Collection
        
        sFound = Dir$(Path & "*.*", vbDirectory)
        While LenB(sFound) <> 0
            If (sFound <> ".") And (sFound <> "..") Then
                oSubDirs.Add sFound
            End If
            
            sFound = Dir()
        Wend
        
        While oSubDirs.Count > 0
            If SearchDirsB(Path & oSubDirs(1) & "\", File, Level - 1) Then
                SearchDirsB = True
                Exit Function
            End If
        
            oSubDirs.Remove 1
        Wend
    End If
End FunctionPrivate Sub Command1_Click()
    Call SearchDirsB("E:\ABC\", "1.exe", 2)
    Picture1.Cls
    Picture1.Print "查找完成!"
End Sub