Lấy danh sách thư mục & thư mục con bằng Mapbasic và Windows API

Hàm GetFileList mà bạn có thể sao chép vào Project của MapBasic (lưu ý: cần sao chép các phần: delarations, type, defines…)

Function GetFileList(ByVal strFilePath as String, 
                     ByVal strFileFilter as String, 
                     strFileList() as String
                     ) as Logical

Tất cả những gì bạn phải làm là gọi hàm và cung cấp một thư mục bắt đầu strFilePath (Lưu ý: đảm bảo bạn có dấu gạch chéo), bộ lọc strFileFilter (ví dụ: "* .tab", "*. *") Và một mảng kiểu chuỗi lưu trữ các danh sách của thư mục tập tin.

Bạn có thể tải mã nguồn về từ đây: DirectoryScan.mb

Include "MAPBASIC.def"

Type FILETIME
   dwLowDateTime As Integer
   dwHighDateTime As Integer
End Type

Type WIN32_FIND_DATA
   dwFileAttributes As Integer
   ftCreationTime As FILETIME   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Integer
   nFileSizeLow As Integer
   dwReserved0 As Integer
   dwReserved1 As Integer
   cFileName As String * 260   cAlternate As String * 14
End Type

Define FILE_ATTRIBUTE_DIRECTORY 16

Declare Sub Main()

Declare Function GetFileList(ByVal strFilePath as String, ByVal strFileFilter as String, strFileList() as String) as Logical

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Integer

Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Integer, lpFindFileData As WIN32_FIND_DATA) As Integer

Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Integer) As Integer
'------------------------------------------------------------------------------------------------
Sub Main()
OnError Goto CatchEx

   Dim bResult As Logical
   Dim strDir As String
   Dim saFileNames() as String
   Dim i as integer
   
   Print chr$(12)
   
   strDir = "C:\Temp\"

   bResult = GetFileList(strDir, ".tab" , saFileNames())
   
   If bResult = True Then
      
      For i = 1 to UBound(saFileNames())
         Print i & ": " & saFileNames(i)
      Next

      Note "Total files found: " & UBound(saFileNames())
   
   Else
      Note strDir & " Doesn't Exist"
   End If

Done:
   Exit Sub

CatchEx:
   Note Error$()
   Resume Done
End Sub
'------
Function GetFileList(ByVal strFilePath as String, ByVal strFileFilter as String, strFileList() asString) as Logical
OnError Goto CatchEx

   Dim hFind As Integer
   Dim wfd As WIN32_FIND_DATA Dim strFileName as String

   Dim iReturn as Integer 
   iReturn = 1
   
   Dim i as Integer
   i = 1 

   Dim strSubDirFileList() as String

   Dim j as Integer

   hFind = FindFirstFile(strFilePath & "*.*", wfd)

   strFileName = LTrim$(RTrim$(wfd.cFileName))
   
   If Len(strFileName) > 0 Then

      Do While iReturn <> 0

         If strFileName = "." or strFileName = ".." then
            iReturn = FindNextFile(hFind, wfd)strFileName = LTrim$(RTrim$(wfd.cFileName))
         Else
         strFileName = LTrim$(RTrim$(wfd.cFileName))
            If wfd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
               iReturn = GetFileList(strFilePath & strFileName & "\", strFileFilter, strSubDirFileList())
               For j = 1 to Ubound(strSubDirFileList)
                  ReDim strFileList(i)
                  strFileList(i) = strSubDirFileList(j)
                  i = i + 1 
               Next
              iReturn = FindNextFile(hFind, wfd)
            Else
               If Right$(strFileName, Len(strFileFilter)) = strFileFilter then
                  ReDim strFileList(i)strFileList(i)= strFilePath & strFileName
                  i = i + 1
               End If
               iReturn = FindNextFile(hFind, wfd)
            End If
         End If
      Loop
   End If

   iReturn = FindClose(hFind)
   GetFileList = true

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Function 

Hàm GetFileList dưới đây bạn có thể sao chép vào Project của mình (lưu ý cần sao chép các phần: delarations, type, defines,…)