Option Explicit
Public Const INVALID_HANDLE_VALUE = -1
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 Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public mStopSearch As Boolean
Dim WFD As WIN32_FIND_DATA, hItem&, hFile&
Dim dirCount&, lFileCount&, i&
Dim filepath$
Dim dirArray$()
Dim dwFileAttributes As Long
Public Sub SearchDirs(filepath$)
Dim WFD As WIN32_FIND_DATA, hItem&, hFile&
Dim dirCount&, i&
Dim dirArray$()
DoEvents
If Right(filepath$, 1) <> "\" Then filepath$ = filepath$ & "\"
hItem& = FindFirstFile(filepath$ & "*", WFD)
If hItem& <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
'排除 "." or ".." DOS 子目录,Asc(.)=46
If Asc(WFD.cFileName) <> 46 Then
'重新分配数组当目录数单位为10个块,加快操作速度
If (dirCount& Mod 3) = 0 Then ReDim Preserve dirArray(dirCount& + 20)
dirCount& = dirCount& + 1
'ReDim Preserve dirArray(dirCount&) ,也可以即时分配内存
dirArray(dirCount&) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
End If
End If
Loop While FindNextFile(hItem&, WFD) '获取下一个子目录
'关闭查找文件的句柄
Call FindClose(hItem&) '关闭FindFirstFile
End If
hFile& = FindFirstFile(filepath$ & "*.*", WFD)
If hFile& <> INVALID_HANDLE_VALUE Then
Do
DoEvents
If Not mStopSearch Then Exit Sub
'排除 "." or ".." DOS 子目录,Asc(.)=46
If Asc(WFD.cFileName) <> 46 Then
lFileCount = lFileCount + 1
Form1.Label1.Caption = lFileCount & filepath$ & WFD.cFileName
End If
Loop While FindNextFile(hFile&, WFD)
Call FindClose(hFile&)
End If
For i& = 1 To dirCount&
SearchDirs filepath$ & dirArray(i&) & "\"
Next i&
Erase dirArray()
End Sub
