Scan / Search directory and sub directories using Mapbasic and Windows API

In this post I will demonstrate how to scan a directory and sub-directories and return a list of files.

I have coded the function GetFileList that you can copy into your project (make sure you also copy the required delarations, type, defines ect...)

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

All you have to do is call the funtion and parse a starting directory strFilePath (Note: make sure you have a trailing slash), a filter strFileFilter (eg "*.tab", "*.*") and a string array to accept the string file directories.

You can download a copy of the source code here 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() as String) 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
'------------------------------------------------------------------------------------------------