+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Program Solution#3 (/showthread.php?tid=3751)
Program Solution#3 - eoredson - 06-17-2025
Program for a recursive directory display function.
Code: (Select All)
Rem sample of a simple recursive directory function.
' declare library structures.
Const INVALID_HANDLE_VALUE = -1
Const Max_path = 260
Type FILETIME
dwLowDateTime As _Unsigned Long
dwHighDateTime As _Unsigned Long
End Type
Type WIN32_FIND_DATAA
dwFileAttributes As _Unsigned Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As _Unsigned Long
nFileSizeLow As _Unsigned Long
dwReserved0 As _Unsigned Long
dwReserved1 As _Unsigned Long
cFileName As String * Max_path
cAlternateFileName As String * 14
End Type
' declare external libraries.
Declare Dynamic Library "kernel32"
Function FindFirstFileA& (ByVal lpFileName~%&, ByVal lpFindFileData~%&)
Function FindNextFileA& (ByVal hFindFile~%&, ByVal lpFindFileData~%&)
Function FindClose& (ByVal hFindFile~%&)
End Declare
' declare shared variables
Dim Shared Recurse.Counter As Integer
Dim Shared Continuous.Display As Integer
Dim Shared Line.Counter As Integer
Dim Shared Quit.Searching As Integer
_ScreenMove _Middle
f$ = _SelectFolderDialog$("Enter directory.", _CWD$)
If Len(f$) = 0 Then
f$ = _CWD$
End If
If Len(f$) Then
If Right$(f$, 1) <> "\" Then f$ = f$ + "\"
Call Recurse_Directories(f$)
Print "Directories counted:"; Recurse.Counter
End If
Color 7
End
' subroutine to recursively access subdirectories
Sub Recurse_Directories (Directory.Search$)
' declare subroutine variables
Dim Attribute As _Unsigned Long
Dim ASCIIZ As String * 260
Dim finddata As WIN32_FIND_DATAA
Dim Wfile.Handle As _Offset
' make directory filename
ASCIIZ = Directory.Search$ + "*.*" + Chr$(0)
' check recursive exit subroutine
If Quit.Searching Then GoTo Quit.Search
' start directory search
Wfile.Handle = FindFirstFileA(_Offset(ASCIIZ), _Offset(finddata))
If Wfile.Handle <> INVALID_HANDLE_VALUE Then
' check display length
If InKey$ = Chr$(27) Then
Quit.Searching = -1: GoTo Quit.Search
End If
Length3 = Len(Directory.Search$)
Z = _Width
Line.Counter = Line.Counter + Int(Length3 / Z) + 1
Z = _Height - 1
If Line.Counter >= Z Then
Line.Counter = 0
If Continuous.Display = 0 Then
Color 15
Print "-more(y/n/c)-";
Do
_Limit 50
V$ = LCase$(InKey$)
If V$ = Chr$(13) Then Print: Exit Do
If V$ = " " Then Print: Exit Do
If V$ = "y" Then Print: Exit Do
If V$ = "n" Then Print: Quit.Searching = -1: GoTo Quit.Search
If V$ = "c" Then Print: Continuous.Display = -1: Exit Do
Loop
End If
End If
' print directory
Color 14
Print Directory.Search$
Recurse.Counter = Recurse.Counter + 1
' recurse subdirectories
Do
' check directory attribute
Attribute = finddata.dwFileAttributes
' check directory
If (Attribute And &H10) = &H10 Then
' store directory name
Directory$ = finddata.cFileName
Directory$ = Left$(Directory$, InStr(Directory$, Chr$(0)) - 1)
' store short filename
If InStr(Directory$, "?") Then
Directory$ = finddata.cAlternateFileName
v = InStr(Directory$, Chr$(0))
If v Then Directory$ = Left$(Directory$, v - 1)
End If
' check directory name
If Directory$ <> "." And Directory$ <> ".." Then
' make next search directory
Next.Directory$ = Directory.Search$ + Directory$ + "\"
' recursively search subdirectories
Call Recurse_Directories(Next.Directory$)
End If
End If
Loop While FindNextFileA(Wfile.Handle, _Offset(finddata))
x = FindClose(Wfile.Handle)
End If
Exit Sub
Quit.Search:
If Wfile.Handle Then
x = FindClose(Wfile.Handle)
End If
End SubRE: Program Solution#3 - SierraKen - 06-17-2025
This is great! Thanks for the code, I might use it sometime for things.