回 帖 发 新 帖 刷新版面

主题:[原创]非递归法遍历文件

最近写directfilemanager中的一个扩展程序需要扫描磁盘文件,调用常见的递归方式遍历文件,结果堆栈溢出,于是写了个非递归的遍历文件函数,性能还要好些,分享下:

Option Explicit
Option Base 0
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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) 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 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 Type
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
Public Function SearchFiles(ByVal SearchPath As String, GetFilePathName() As String) As Long
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA
    Dim curF As Long
    Dim curPath As String
    Dim CountAll As Long
    Dim NextSearch As Long
    Dim FileName As String
    ReDim GetFilePathName(0)
    GetFilePathName(0) = IIf(Right(SearchPath, 1) = "\", Left(SearchPath, Len(SearchPath) - 1), SearchPath)
    Do
        curPath = GetFilePathName(curF)
        If GetFileAttributes(curPath) And FILE_ATTRIBUTE_DIRECTORY Then
            curPath = curPath & "\*"
            hSearch = FindFirstFile(curPath, WFD)
            If hSearch <> INVALID_HANDLE_VALUE Then
                Do
                    FileName = StripNulls(WFD.cFileName)
                    If (FileName <> ".") And (FileName <> "..") Then
                        CountAll = CountAll + 1
                        ReDim Preserve GetFilePathName(CountAll)
                        GetFilePathName(CountAll) = GetFilePathName(curF) & "\" & FileName
                    End If
                    NextSearch = FindNextFile(hSearch, WFD)
                Loop While NextSearch > 0
            End If
            Call FindClose(hSearch)
        End If
    curF = curF + 1
    Loop While curF <= CountAll
    SearchFiles = CountAll
End Function

回复列表 (共5个回复)

沙发

我也贴个 呵呵
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 FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMdivSSED = &H800
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

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
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 * MAX_PATH
    cAlternate As String * 14
End Type


板凳

'*************************************************************************
'**功能描述: 遍历目录子文件名
'**函 数 名: GetFileList
'**输    入: ByVal Path(String)                  - 要获取子文件名的目录
'**        : Optional Filter(String)             - [文件类型]
'**        : Optional bGetDir(Boolean = True)    - [是否获取目录]
'**        : Optional bGetFile(Boolean = True)   - [是否获取文件]
'**        : Optional bGetSubDir(Boolean = True) - [是否获取子目录下的文件]
'**        : Optional bAbsPath(Boolean = True)   - [是否使用绝对路径]
'**        : Optional sSubDir(String)            -
'**        : Optional FileArr)(String$()         -
'**输    出: String$()
'*************************************************************************
Public Function GetFileList(ByVal Path As String, _
                            Optional Filter As String, _
                            Optional bGetDir As Boolean = True, _
                            Optional bGetFile As Boolean = True, _
                            Optional bGetSubDir As Boolean = True, _
                            Optional bAbsPath As Boolean = True, _
                            Optional sSubDir As String, _
                            Optional FileArr) _
                            As String()

    Dim SubDir() As String '存放当前目录下的子目录,下标可根据需要调整
    Dim i As Integer '用于循环子目录的查找
    Dim lHandle As Long 'FindFirstFileA 的句柄
    Dim tFindData As WIN32_FIND_DATA '
    Dim FileName As String '文件名

    On Error Resume Next
    '初始化变量
    SubDir = Split("")

    Filter = Trim$(Filter)
    If Len(Filter) = 0 Or InStr(Filter, ".") = 0 Then Filter = "*.*"

    If TypeName(FileArr) = "Error" Then FileArr = Split("")
    If Right$(Path, 1) <> "\" Then Path = Path & "\"

    lHandle = FindFirstFile(Path & "*.*", tFindData)
    If lHandle = 0 Then Exit Function '查询结束或发生错误

    

3 楼

'循环查找下一个文件,直到结束
    Do
        FileName = Left$(tFindData.cFileName, InStr(tFindData.cFileName, Chr$(0)) - 1)

        If FileName <> "." And FileName <> ".." And Len(FileName) > 0 Then
            If tFindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then '目录
                ReDim Preserve SubDir(UBound(SubDir) + 1)
                SubDir(UBound(SubDir)) = FileName & "\"

                If bGetDir = True Then '同样获取目录
                    ReDim Preserve FileArr(UBound(FileArr) + 1)
                    FileArr(UBound(FileArr)) = IIf(bAbsPath = True, Path & FileName, sSubDir & FileName)
                End If
            End If
        End If

        If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
            FindClose (lHandle)
            Exit Do
        End If

        DoEvents
    Loop

    If bGetFile = True Then
        lHandle = FindFirstFile(Path & Filter, tFindData)
        If lHandle = 0 Then Exit Function '查询结束或发生错误

        '循环查找下一个文件,直到结束
        Do
            FileName = Left$(tFindData.cFileName, InStr(tFindData.cFileName, Chr$(0)) - 1)

            If FileName <> "." And FileName <> ".." And Len(FileName) > 0 Then
                If tFindData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY Then '文件
                    ReDim Preserve FileArr(UBound(FileArr) + 1)
                    FileArr(UBound(FileArr)) = IIf(bAbsPath = True, Path & FileName, sSubDir & FileName)

                End If
            End If

            If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
                FindClose (lHandle)
                Exit Do
            End If

            DoEvents
        Loop
    End If

    If bGetSubDir = True Then
        '如果该目录下有目录,则根据目录数组递归遍历
        For i = 0 To UBound(SubDir)
            GetFileList Path & SubDir(i), Filter, bGetDir, bGetFile, bGetSubDir, bAbsPath, SubDir(i), FileArr
        Next
    End If

    GetFileList = FileArr
End Function

4 楼

有点复杂,而且你那个是递归的啊,如果目录太深会堆栈错误!

我也有个递归的函数,好像比你的简单点,不过以后我不会再用它了:

'前面的申明都一样
Public Function FindFiles(ByVal SearchPath As String, GetFindFile() As String, ByVal IsFindSubDir As Boolean, ByVal IsGetFullPath As Boolean, Optional ByVal IsGetDirName As Boolean = True, Optional FileCount As Long, Optional DirCount As Long, Optional ExNameFilter As String) As Long
On Error GoTo EX
    Dim hSearch As Long
    Dim SubDir As String
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Long
    Static nDir As Long
    Static nFile As Long
    Static nFolder As Long
    Static CountFunction As Long
    Static SFilter() As String
    Dim thisIsFirst As Long
    Dim DirName As String, N As Long
    Static FilterN As Long
    
    thisIsFirst = CountFunction
    CountFunction = CountFunction + 1
    SearchPath = Trim(SearchPath)
    If thisIsFirst = 0 Then
        If ExNameFilter = "" Then
            FilterN = -1
        Else
            SFilter = Split(UCase(ExNameFilter), ";")
            FilterN = UBound(SFilter)
        End If
    End If
    If Right(SearchPath, 1) <> "\" Then SearchPath = SearchPath & "\"
    Cont = True
    hSearch = FindFirstFile(SearchPath & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
            DirName = StripNulls(WFD.cFileName)
            If (DirName <> ".") And (DirName <> "..") Then
                If GetFileAttributes(SearchPath & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                    If IsGetDirName Then
                        ReDim Preserve GetFindFile(nDir)
                        GetFindFile(nDir) = IIf(IsGetFullPath, SearchPath & DirName, DirName)
                        nDir = nDir + 1
                        nFolder = nFolder + 1
                    End If
                    If IsFindSubDir Then
                        Call FindFiles(SearchPath & DirName, GetFindFile(), IsFindSubDir, IsGetFullPath, IsGetDirName)
                    End If
                Else
                    If FilterN = -1 Or IsInFilter(SFilter, DirName, FilterN) Then
                        ReDim Preserve GetFindFile(nDir)
                        GetFindFile(nDir) = IIf(IsGetFullPath, SearchPath & DirName, DirName)
                        nDir = nDir + 1
                        nFile = nFile + 1
                    End If
                End If
            End If
            Cont = FindNextFile(hSearch, WFD)
        Loop
        Cont = FindClose(hSearch)
    End If
EX:
    If thisIsFirst = 0 Then
        FindFiles = nDir
        FileCount = nFile
        DirCount = nFolder
        nDir = 0
        nFile = 0
        nFolder = 0
        CountFunction = 0
    End If
End Function

Private Function IsInFilter(sfileFilter() As String, thisFile As String, filterLen As Long) As Boolean
    Dim N As Long, bufS As String, M As Long
    bufS = UCase(thisFile)
    Do
        M = InStr(bufS, ".")
        bufS = Right(bufS, Len(bufS) - M)
    Loop While M <> 0
    If bufS = "" Then Exit Function
    For N = 0 To filterLen
        If sfileFilter(N) = bufS Or sfileFilter(N) = "*." & bufS Then IsInFilter = True: Exit Function
    Next N
End Function

5 楼

在网上搜了搜,非递归的遍历文件算法竟然没看到vb的代码,心酸啊!

我来回复

您尚未登录,请登录后再回复。点此登录或注册