Tác giả: MATH-INFO
Mô tả: Thông thường chúng ta hay duyệt tập tin thư mục con bằng cách gọi đệ quy, đó là cách duyệt theo chiều sâu, khi đó sẽ có thể tốn bộ nhớ do windows sẽ tạo ra nhiều stack sau mỗi lời gọi đệ quy. Nay mình xin giới thiệu kỹ thuật duyệt file theo chiều rộng (không dùng đệ quy), bằng cách dùng thêm một Collection để lưu lại các sub folder chưa được duyệt, sub folder nào duyệt xong sẽ được remove ra khỏi Collection.
Đoạn code sau sẽ dùng hàm 2 hàm API để duyệt: FindFirstFile và FindNextFile.
Áp dụng được cho tập tin thư mục có tên Unicode
Tạo ra một form gồm có một textbox Text1 và 1 button Command1, copy đoạn code dưới vào form.
Code: Select all
Option Explicit Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Const FILE_ATTRIBUTE_DIRECTORY = &H10Const FILE_ATTRIBUTE_HIDDEN = &H2Const FILE_ATTRIBUTE_NORMAL = &H80Const FILE_ATTRIBUTE_READONLY = &H1Const FILE_ATTRIBUTE_SYSTEM = &H4 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As LongEnd 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 * 255 cAlternate As String * 14End Type Private Sub Command1_Click() Dim DirCount As Integer, fileCount As Integer WalkDir Text1.Text, DirCount, fileCount MsgBox "Folder: " & DirCount & " - File: " & fileCountEnd Sub Private Sub WalkDir(sFolder As String, DirCount As Integer, fileCount As Integer) Dim myFolder As New Collection Dim FileData As WIN32_FIND_DATA Dim res As Long, hSearch As Long, fileName As String DirCount = 0 fileCount = 0 myFolder.Add (sFolder) Do While (myFolder.Count) sFolder = myFolder.Item(1) myFolder.Remove (1) hSearch = FindFirstFile(StrConv(sFolder & "\*.*", vbUnicode), FileData) If (hSearch = -1) Then GoTo 1 Do fileName = TrimPath(FileData.cFileName) If (fileName <> ".") And (fileName <> "..") Then If (FileData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then myFolder.Add (sFolder & "\" & fileName) DirCount = DirCount + 1 '---------------' ' do some thing ' '---------------' Else fileCount = fileCount + 1 '---------------' ' do some thing ' '---------------' End If End If res = FindNextFile(hSearch, FileData) Loop Until (res = 0) 1: FindClose (hSearch) LoopEnd Sub Private Function TrimPath(sPath As String) As String Dim i As Integer sPath = StrConv(sPath, vbFromUnicode) i = InStr(sPath, Chr(0)) If i > 0 Then sPath = Left(sPath, i - 1) TrimPath = sPathEnd Function 
