FindFirstFile FindNextFile 检索c:\根目录 错误

Question

模块内的函数声明
Public Declare Function FindFirstFile _
               Lib "kernel32" _
               Alias "FindFirstFileA" (ByVal lpFileName As String, _
                                       lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile _
               Lib "kernel32" _
               Alias "FindNextFileA" (ByVal hFindFile As Long, _
                                      lpFindFileData As WIN32_FIND_DATA) As LongPublic 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 * 260
    cAlternate        As String * 14End Type
窗体内的代码
    Dim hFile As Long '用于存储文件号    Dim WFD   As WIN32_FIND_DATA
    
    hFile& = FindFirstFile("c:\", WFD)  '开始检索文件
    
    If hFile& > 0 Then '如果有文件,则继续查找其他文件或文件夹
        '一些其他的代码
              
        While FindNextFile(hFile, WFD) '以第一个文件为起点 继续添加 直到结束            '一些其他的代码        Wend    End If我用这个检索磁盘上两个某一个目录内的文件和文件夹
现在有个问题  检索 d:\   e:\  或者 C:\Documents and Settings\over\桌面\ 都没有问题
而检索c:\根目录的时候发生错误,死在循环里面出不来了,而且好像只有c:\根目录会出现问题
有经验的兄弟  提点一下  谢谢

Answer 1

新建一个类，贴入如下代码：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 MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const BIF_RETURNONLYFSDIRS = 1Private 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 * MAX_PATH
    cAlternate As String * 14
End TypePublic Event Progress(ByVal FileName As String)
Public Cancel As Boolean'开始搜索
Public Sub Start(ByVal Path As String, Optional ByVal Filter As String = "*.*", Optional ByVal SubDir As Boolean = True)
    Dim FileName As String
    Dim DirName As String
    Dim dirNames() As String
    Dim nDir As Long, Cont As Long, att As Long
    Dim i As Long
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA    If Right(Path, 1) <> "\" Then Path = Path & "\"
    Cancel = False    On Error Resume Next    '搜索子目录
    nDir = 0
    If SubDir Then
        ReDim dirNames(nDir)
        hSearch = FindFirstFile(Path & "*", WFD)
        Cont = 1
        If hSearch <> INVALID_HANDLE_VALUE Then
            Do While Cont
                DirName = StripNulls(WFD.cFileName)                If (DirName <> ".") And (DirName <> "..") Then
                    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                        dirNames(nDir) = DirName
                        nDir = nDir + 1
                        ReDim Preserve dirNames(nDir)
                        '                        RaiseEvent Progress(Path & DirName)
                        If Cancel Then Exit Sub
                    End If
                End If
                Cont = FindNextFile(hSearch, WFD)          '获取下一个子目录
            Loop
            Cont = FindClose(hSearch)
        End If
    End If    ' 查找目录并累计文件总数
    hSearch = FindFirstFile(Path & Filter, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                RaiseEvent Progress(Path & FileName)
                If Cancel Then Exit Sub
            End If
            Cont = FindNextFile(hSearch, WFD)              ' 获取下一个文件
        Wend
        Cont = FindClose(hSearch)
    End If    '如果子目录存在则查找之
    If nDir > 0 Then
        For i = 0 To nDir - 1
            Call Start(Path & dirNames(i) & "\", Filter, SubDir)
            If Cancel Then Exit Sub
        Next i
    End If
End Sub'自定义函数
Private Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function