Author Topic: Bas Files Count and List by Recursive Algorithm (Read 13931 times)

SpriggsySpriggs · « **Reply #15 on:** November 08, 2021, 08:21:47 pm »

Also, this is a simple alternative for recursive files listing :)

Code: QB64: [Select]

Option _Explicit
$Console:Only
 
Dim comm As String
Dim x#, y#
Dim path As String
x# = Timer(0.01)
path = _CWD$
comm = pipecom_lite("PowerShell Get-ChildItem -Path \" + Chr$(34) + path + "\" + Chr$(34) + " -Recurse -Force -ErrorAction SilentlyContinue -Attributes Hidden, !Hidden ^| Select-Object -ExpandProperty FullName ^| Sort-Object ^| Format-Table -AutoSize")
 
y# = Timer(0.01)
Print Len(comm)
Print y# - x#; " seconds"
ReDim As String filelist(0)
String.Split comm, Chr$(10), filelist()
Print UBound(filelist)
Dim As _Integer64 i
For i = 1 To UBound(filelist)
    Print i, filelist(i)
Next
Sleep
 
'$INCLUDE:'pipecomqb64.bas'
Sub String.Split (Expression As String, delimiter As String, StorageArray() As String)
    Dim copy As String, p As Long, curpos As Long, arrpos As Long, dpos As Long
    copy = Expression
    If delimiter = " " Then
        copy = RTrim$(LTrim$(copy))
        p = InStr(copy, "  ")
        While p > 0
            copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
            p = InStr(copy, "  ")
        Wend
    End If
    curpos = 1
    arrpos = UBound(StorageArray)
    dpos = InStr(curpos, copy, delimiter)
    Do Until dpos = 0
        StorageArray(UBound(StorageArray)) = Mid$(copy, curpos, dpos - curpos)
        ReDim _Preserve StorageArray(UBound(StorageArray) + 1) As String
        curpos = dpos + Len(delimiter)
        dpos = InStr(curpos, copy, delimiter)
    Loop
    StorageArray(UBound(StorageArray)) = Mid$(copy, curpos)
    ReDim _Preserve StorageArray(UBound(StorageArray)) As String
End Sub

SMcNeill · « **Reply #16 on:** November 08, 2021, 09:13:19 pm »

Quote from: SpriggsySpriggs on November 08, 2021, 08:19:19 pm

If I remember correctly, Steve had a bug in his code that would falsely identify some directories as files or vice-versa. Maybe that's why you have a difference in number of files found between his code and CMD.

That wasn't so much a bug as just cleaning up the code with newer QB64 commands. When I first worked up the routine, we didn't have a _DIREXISTS and _FILEEXISTS, so we passed flags from the POSIX commands back to sort which was which. They work, but are redundant and folks kept mixing up which flag was which. (It's not a 0 or -1 flag, but instead a 1 or 2 value, so checking IF flag THEN... is always going to fail.) Swapping to _DIREXISTS and _FILEEXISTS cleaned out those constants and keeps things simple for people who wanted to tweak the routine for personal needs.

If I had to guess at the file count difference, I'd guess they're in a hidden directory (like the Recycle Bin) which dir is going to skip unless you set the /ah flags with it. The POSIX routines will list those files without regards of the flags.

bplus · « **Reply #17 on:** November 08, 2021, 09:32:20 pm »

Thanks @SpriggsySpriggs

That gets me independent confirmation that we agree on at least a smallish Directory and SubDirectories, a couple tiny mods for ease of comparison (I just inserted pipecom.bas where you said include, so one file program):

Code: QB64: [Select]

Option _Explicit
' Spriggsy  ref: https://www.qb64.org/forum/index.php?topic=4360.msg137995#msg137995
' bplus mods a bit to compare to other counts  2021-11-08
 
$Console:Only
 
Dim comm As String
Dim path As String
ReDim As String filelist(0)
Dim As _Integer64 i
Dim GrandTotal As _Unsigned Long
 
path = _CWD$
comm = pipecom_lite("PowerShell Get-ChildItem -Path \" + Chr$(34) + path + "\" + Chr$(34) + _
" -Recurse -Force -ErrorAction SilentlyContinue -Attributes Hidden, " + _
"!Hidden ^| Select-Object -ExpandProperty FullName ^| Sort-Object ^| Format-Table -AutoSize")
String.Split comm, Chr$(10), filelist()
Open path + "\Count and List Bas by Spriggsy.txt" For Output As #1
For i = 1 To UBound(filelist)
    If UCase$(Right$(filelist(i), 4)) = ".BAS" Then
        GrandTotal = GrandTotal + 1
        Print GrandTotal, filelist(i)
        Print #1, filelist(i)
    End If
Next
Close #1
Print " Grandtotal ="; GrandTotal
Sleep
 
' Spriggsy's pipecom.bas include
$If PIPECOM = UNDEFINED Then
    $Let PIPECOM = TRUE
    Function pipecom& (cmd As String, stdout As String, stderr As String)
        stdout = "": stderr = ""
        $If WIN Then
            Type SECURITY_ATTRIBUTES
                As Long nLength
                $If 64BIT Then
                    As Long padding
                $End If
                As _Offset lpSecurityDescriptor
                As Long bInheritHandle
                $If 64BIT Then
                    As Long padding2
                $End If
            End Type
 
            Type STARTUPINFO
                As Long cb
                $If 64BIT Then
                    As Long padding
                $End If
                As _Offset lpReserved, lpDesktop, lpTitle
                As Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
                As Integer wShowWindow, cbReserved2
                $If 64BIT Then
                    As Long padding2
                $End If
                As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
            End Type
 
            Type PROCESS_INFORMATION
                As _Offset hProcess, hThread
                As Long dwProcessId
                $If 64BIT Then
                    As Long padding
                $End If
            End Type
 
            Const STARTF_USESTDHANDLES = &H00000100
            Const CREATE_NO_WINDOW = &H8000000
 
            Const INFINITE = 4294967295
            Const WAIT_FAILED = &HFFFFFFFF
 
            Declare CustomType Library
                Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As Long)
                Function CreateProcess& (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Integer, Byval dwCreationFlags As Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfor As _Offset, Byval lpProcessInformation As _Offset)
                Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
                Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
                Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
                Function WaitForSingleObject& (ByVal hHandle As _Offset, Byval dwMilliseconds As Long)
            End Declare
 
            Dim As Long ok: ok = 1
            Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
            Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
 
            If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            Dim As STARTUPINFO si
            si.cb = Len(si)
            si.dwFlags = STARTF_USESTDHANDLES
            si.hStdError = hStdOutPipeError
            si.hStdOutput = hStdOutPipeWrite
            si.hStdInput = 0
            Dim As PROCESS_INFORMATION procinfo
            Dim As _Offset lpApplicationName
            Dim As String fullcmd: fullcmd = "cmd /c " + cmd + Chr$(0)
            Dim As String lpCommandLine: lpCommandLine = fullcmd
            Dim As _Offset lpProcessAttributes, lpThreadAttributes
            Dim As Integer bInheritHandles: bInheritHandles = 1
            Dim As Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
            Dim As _Offset lpEnvironment, lpCurrentDirectory
            ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
 
            If ok = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            HandleClose hStdOutPipeWrite
            HandleClose hStdOutPipeError
 
            Dim As String buf: buf = Space$(4096 + 1)
            Dim As Long dwRead
            While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stdout = stdout + buf
                buf = Space$(4096 + 1)
            Wend
 
            While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stderr = stderr + buf
                buf = Space$(4096 + 1)
            Wend
 
            Dim As Long exit_code, ex_stat
            If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
                If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
                    ex_stat = 1
                End If
            End If
 
            HandleClose hStdOutPipeRead
            HandleClose hStdReadPipeError
            If ex_stat = 1 Then
                pipecom = exit_code
            Else
                pipecom = -1
            End If
 
            Exit Function
 
            RemoveChr13:
            Dim As Long j
            j = InStr(buf, Chr$(13))
            Do While j
                buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
                j = InStr(buf, Chr$(13))
            Loop
            Return
        $Else
            Declare CustomType Library
            Function popen%& (cmd As String, readtype As String)
            Function feof& (ByVal stream As _Offset)
            Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
            Function pclose& (ByVal stream As _Offset)
            End Declare
 
            Declare Library
            Function WEXITSTATUS& (ByVal stat_val As Long)
            End Declare
 
            Dim As String pipecom_buffer
            Dim As _Offset stream
 
            Dim buffer As String * 4096
            If _FileExists("pipestderr") Then
            Kill "pipestderr"
            End If
            stream = popen(cmd + " 2>pipestderr", "r")
            If stream Then
            While feof(stream) = 0
            If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
            stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
            End If
            Wend
            Dim As Long status, exit_code
            status = pclose(stream)
            exit_code = WEXITSTATUS(status)
            If _FileExists("pipestderr") Then
            Dim As Integer errfile
            errfile = FreeFile
            Open "pipestderr" For Binary As #errfile
            If LOF(errfile) > 0 Then
            stderr = Space$(LOF(errfile))
            Get #errfile, , stderr
            End If
            Close #errfile
            Kill "pipestderr"
            End If
            pipecom = exit_code
            Else
            pipecom = -1
            End If
        $End If
    End Function
 
    Function pipecom_lite$ (cmd As String)
        Dim As Long a
        Dim As String stdout, stderr
        a = pipecom(cmd, stdout, stderr)
        If stderr <> "" Then
            pipecom_lite = stderr
        Else
            pipecom_lite = stdout
        End If
    End Function
$End If
 
Sub String.Split (Expression As String, delimiter As String, StorageArray() As String)
    Dim copy As String, p As Long, curpos As Long, arrpos As Long, dpos As Long
    copy = Expression
    If delimiter = " " Then
        copy = RTrim$(LTrim$(copy))
        p = InStr(copy, "  ")
        While p > 0
            copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
            p = InStr(copy, "  ")
        Wend
    End If
    curpos = 1
    arrpos = UBound(StorageArray)
    dpos = InStr(curpos, copy, delimiter)
    Do Until dpos = 0
        StorageArray(UBound(StorageArray)) = Mid$(copy, curpos, dpos - curpos)
        ReDim _Preserve StorageArray(UBound(StorageArray) + 1) As String
        curpos = dpos + Len(delimiter)
        dpos = InStr(curpos, copy, delimiter)
    Loop
    StorageArray(UBound(StorageArray)) = Mid$(copy, curpos)
    ReDim _Preserve StorageArray(UBound(StorageArray)) As String
End Sub
 
 

And here is how 4 compare, yours, Steve's, my fixed recursive and my non recursive (both ChDir):

bplus · « **Reply #18 on:** November 08, 2021, 09:59:02 pm »

Quote

Umm... But it is recursive. GetAll calls itself until done... 😂😂

OK I have contracted the Dimster's blindness to recursive calls ;-)) so I better for sure make it the Best Answer!

bplus · « **Reply #19 on:** November 08, 2021, 11:49:16 pm »

Well I did pickup a discrepancy between file counts between Spriggsy's Method and Steve's. Out of 11,850 files on my Desktop Spriggy's Method picked up two more than Steve's.

Here is test code and the two files are from SmallBasic Directories:

Could there be some character one method finds and the other doesn't?

bplus · « **Reply #20 on:** November 09, 2021, 12:02:30 am »

Oh hey, I copy Steve's notes on GetAll and converted them into comments to paste into the source file:

Code: QB64: [Select]

' Note that Ive also tweaked the GetDir routine here so that it just does a
' simple file dump for us, without presorting files and directories for us.  (I
' also added the full path onto the file names, which I think is essential in a
' case of recursion so you can tell what the heck it found where...)  This has
' no issues on my PC starting at the root drive and working its way down into
' the various subdirectories, and as far as I can tell its not missing anything.
'  Note 2:  This doesnt autoclear the old directory listing and builds upon it
' as you call it.  If youre going to call the routine multiple times, reset your
' listing with a fresh ReDim As String Dir(0) before making the call to GetAll. 
 

I know these notes important because I think I missed something about using getLists that required me to ChDir to get a proper listing of files and directories of the Current Working Directory, some time ago.

@SMcNeill if your up for a little puzzle here is GetLists that I have, that works pretty good when I ChDir to the directory I was to get the lists.

Code: QB64: [Select]

Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
    ' Thanks SNcNeill ! for a cross platform method to get file and directory lists
    'put this block in main code section of your program close to top
    '' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    'DECLARE CUSTOMTYPE LIBRARY ".\direntry"
    '    FUNCTION load_dir& (s AS STRING)
    '    FUNCTION has_next_entry& ()
    '    SUB close_dir ()
    '    SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
    'END DECLARE
 
    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
    Dim nam$
    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0
 
    If load_dir(SearchDirectory + Chr$(0)) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If (flags And IS_DIR) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until length = -1
        'close_dir 'move to after end if  might correct the multi calls problem
    Else
    End If
    close_dir 'this  might correct the multi calls problem
 
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub
 

SMcNeill · « **Reply #21 on:** November 09, 2021, 04:34:09 am »

Those 2 files that were missed, can you see what attributes they have set? System? Hidden? Archived? Or something else odd? Do they flag properly with _DIREXISTS? I'm curious why it may have skipped them.

SMcNeill · « **Reply #22 on:** November 09, 2021, 06:22:25 am »

See if this works without missing any files for you:

Code: QB64: [Select]

ReDim As String Dir(0), File(0)
 
GetLists "D:\repo\qb64", Dir(), File()
For i = 1 To UBound(Dir)
    Print Dir(i),
Next
Print: Print
For i = 1 To UBound(File)
    Print File(i),
Next
 
 
Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
    ' Thanks SNcNeill ! for a cross platform method to get file and directory lists
    'put this block in main code section of your program close to top
    '' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Declare CustomType Library ".\direntry"
        Function load_dir& (s As String)
        Function has_next_entry& ()
        Sub close_dir ()
        Sub get_next_entry (s As String, flags As Long, file_size As Long)
    End Declare
 
    Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
    Dim nam$, slash$
    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0
    $If WIN Then
        slash$ = "\"
    $Else
        slash$ = "/"
    $End If
    If Right$(SearchDirectory$, 1) <> "/" And Right$(SearchDirectory$, 1) <> "\" Then SearchDirectory$ = SearchDirectory$ + slash$
 
    If load_dir(SearchDirectory + Chr$(0)) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If _DirExists(SearchDirectory + nam$) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf _FileExists(SearchDirectory + nam$) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    FileList(FileCount) = nam$
                Else 'This else should never actually trigger
                    Print "Unknown file found: "; SearchDirectory; slash$; nam$, _DirExists(nam$)
                    Sleep
                End If
            End If
        Loop Until length = -1
    End If
    close_dir 
 
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub
 
 

This removes the POSIX flag checking and relies on QB64's native _DIREXISTS and _FILEEXISTS to tell us which is a file and which is a directory. If it finds the files but misses identifying the files completely, you'll get a nice BEEP and message. OF course, if it misses the files completely, they just won't show up anywhere for us... :P

bplus · « **Reply #23 on:** November 09, 2021, 10:54:18 am »

Quote from: SMcNeill on November 09, 2021, 04:34:09 am

Those 2 files that were missed, can you see what attributes they have set? System? Hidden? Archived? Or something else odd? Do they flag properly with _DIREXISTS? I'm curious why it may have skipped them.

OK turns out the "files" missed were actually folders that ended in ".bas".

So both methods failed to recognize them as folders, open and catch the .bas file inside each, or did catch what was inside both and Spriggsy's just called the folder a file too. Checking on that next...

SMcNeill · « **Reply #24 on:** November 09, 2021, 11:28:13 am »

Quote from: bplus on November 09, 2021, 10:54:18 am

OK turns out the "files" missed were actually folders that ended in ".bas".

So both methods failed to recognize them as folders, open and catch the .bas file inside each, or did catch what was inside both and Spriggsy's just called the folder a file too. Checking on that next...

Mine wouldn't count a folder as it reports folders as ending with a \.

C:\
C:\temp\
C:\temp\QB64.bas\

The last 4 digits are bas\, not .bas.

They were found but not counted for that reason. ;)

bplus · « **Reply #25 on:** November 09, 2021, 11:39:00 am »

That's probably it Steve, I am sidetracked with -2^-3^-4 nice test for Oh Interpreter, confirming what you just said next...

bplus · « **Reply #26 on:** November 09, 2021, 12:36:59 pm »

Yes, I reconciled the difference in List counts by changing my mod of Spriggsy's code to make sure it's a file we are adding to the list, his code just dumps the whole mess files and folders and I lazily just picked out ones that ended in .BAS

Here is my fix of Spriggsy's to count .Bas Files only:

Code: QB64: [Select]

Option _Explicit
' Spriggsy  ref: https://www.qb64.org/forum/index.php?topic=4360.msg137995#msg137995
' bplus mods a bit to comapare to other counts  2021-11-08
 
$Console:Only
 
Dim comm As String
Dim path As String
ReDim As String filelist(0)
Dim As _Integer64 i
Dim GrandTotal As _Unsigned Long
 
path = "C:\Users\marka\Desktop" ' <<<<<< set the directory to do here
 
 
comm = pipecom_lite("PowerShell Get-ChildItem -Path \" + Chr$(34) + path + "\" + Chr$(34) + _
" -Recurse -Force -ErrorAction SilentlyContinue -Attributes Hidden, " + _
"!Hidden ^| Select-Object -ExpandProperty FullName ^| Sort-Object ^| Format-Table -AutoSize")
String.Split comm, Chr$(10), filelist()
Open path + "\Count and List Bas by Spriggsy.txt" For Output As #1
For i = 1 To UBound(filelist)
    If UCase$(Right$(filelist(i), 4)) = ".BAS" Then ' bplus mod to count .Bas files as asked for in thread
 
        ' bplus changed 2021-11-09 This reconciles the difference I was getting in file counts
        ' if filelist contains folders too how do you tell?
        If _FileExists(filelist(i)) Then ' that should do it and increase the time too
            GrandTotal = GrandTotal + 1 ' now count the FILE!
            Print GrandTotal, filelist(i)
            Print #1, filelist(i)
        End If
 
 
    End If
Next
Close #1
Print " Grand Total ="; GrandTotal
Sleep
 
' Spriggsy's pipecom.bas include
$If PIPECOM = UNDEFINED Then
    $Let PIPECOM = TRUE
    Function pipecom& (cmd As String, stdout As String, stderr As String)
        stdout = "": stderr = ""
        $If WIN Then
            Type SECURITY_ATTRIBUTES
                As Long nLength
                $If 64BIT Then
                    As Long padding
                $End If
                As _Offset lpSecurityDescriptor
                As Long bInheritHandle
                $If 64BIT Then
                    As Long padding2
                $End If
            End Type
 
            Type STARTUPINFO
                As Long cb
                $If 64BIT Then
                    As Long padding
                $End If
                As _Offset lpReserved, lpDesktop, lpTitle
                As Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
                As Integer wShowWindow, cbReserved2
                $If 64BIT Then
                    As Long padding2
                $End If
                As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
            End Type
 
            Type PROCESS_INFORMATION
                As _Offset hProcess, hThread
                As Long dwProcessId
                $If 64BIT Then
                    As Long padding
                $End If
            End Type
 
            Const STARTF_USESTDHANDLES = &H00000100
            Const CREATE_NO_WINDOW = &H8000000
 
            Const INFINITE = 4294967295
            Const WAIT_FAILED = &HFFFFFFFF
 
            Declare CustomType Library
                Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As Long)
                Function CreateProcess& (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Integer, Byval dwCreationFlags As Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfor As _Offset, Byval lpProcessInformation As _Offset)
                Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
                Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
                Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
                Function WaitForSingleObject& (ByVal hHandle As _Offset, Byval dwMilliseconds As Long)
            End Declare
 
            Dim As Long ok: ok = 1
            Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
            Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
 
            If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            Dim As STARTUPINFO si
            si.cb = Len(si)
            si.dwFlags = STARTF_USESTDHANDLES
            si.hStdError = hStdOutPipeError
            si.hStdOutput = hStdOutPipeWrite
            si.hStdInput = 0
            Dim As PROCESS_INFORMATION procinfo
            Dim As _Offset lpApplicationName
            Dim As String fullcmd: fullcmd = "cmd /c " + cmd + Chr$(0)
            Dim As String lpCommandLine: lpCommandLine = fullcmd
            Dim As _Offset lpProcessAttributes, lpThreadAttributes
            Dim As Integer bInheritHandles: bInheritHandles = 1
            Dim As Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
            Dim As _Offset lpEnvironment, lpCurrentDirectory
            ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
 
            If ok = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            HandleClose hStdOutPipeWrite
            HandleClose hStdOutPipeError
 
            Dim As String buf: buf = Space$(4096 + 1)
            Dim As Long dwRead
            While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stdout = stdout + buf
                buf = Space$(4096 + 1)
            Wend
 
            While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stderr = stderr + buf
                buf = Space$(4096 + 1)
            Wend
 
            Dim As Long exit_code, ex_stat
            If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
                If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
                    ex_stat = 1
                End If
            End If
 
            HandleClose hStdOutPipeRead
            HandleClose hStdReadPipeError
            If ex_stat = 1 Then
                pipecom = exit_code
            Else
                pipecom = -1
            End If
 
            Exit Function
 
            RemoveChr13:
            Dim As Long j
            j = InStr(buf, Chr$(13))
            Do While j
                buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
                j = InStr(buf, Chr$(13))
            Loop
            Return
        $Else
            Declare CustomType Library
            Function popen%& (cmd As String, readtype As String)
            Function feof& (ByVal stream As _Offset)
            Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
            Function pclose& (ByVal stream As _Offset)
            End Declare
 
            Declare Library
            Function WEXITSTATUS& (ByVal stat_val As Long)
            End Declare
 
            Dim As String pipecom_buffer
            Dim As _Offset stream
 
            Dim buffer As String * 4096
            If _FileExists("pipestderr") Then
            Kill "pipestderr"
            End If
            stream = popen(cmd + " 2>pipestderr", "r")
            If stream Then
            While feof(stream) = 0
            If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
            stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
            End If
            Wend
            Dim As Long status, exit_code
            status = pclose(stream)
            exit_code = WEXITSTATUS(status)
            If _FileExists("pipestderr") Then
            Dim As Integer errfile
            errfile = FreeFile
            Open "pipestderr" For Binary As #errfile
            If LOF(errfile) > 0 Then
            stderr = Space$(LOF(errfile))
            Get #errfile, , stderr
            End If
            Close #errfile
            Kill "pipestderr"
            End If
            pipecom = exit_code
            Else
            pipecom = -1
            End If
        $End If
    End Function
 
    Function pipecom_lite$ (cmd As String)
        Dim As Long a
        Dim As String stdout, stderr
        a = pipecom(cmd, stdout, stderr)
        If stderr <> "" Then
            pipecom_lite = stderr
        Else
            pipecom_lite = stdout
        End If
    End Function
$End If
 
Sub String.Split (Expression As String, delimiter As String, StorageArray() As String)
    Dim copy As String, p As Long, curpos As Long, arrpos As Long, dpos As Long
    copy = Expression
    If delimiter = " " Then
        copy = RTrim$(LTrim$(copy))
        p = InStr(copy, "  ")
        While p > 0
            copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
            p = InStr(copy, "  ")
        Wend
    End If
    curpos = 1
    arrpos = UBound(StorageArray)
    dpos = InStr(curpos, copy, delimiter)
    Do Until dpos = 0
        StorageArray(UBound(StorageArray)) = Mid$(copy, curpos, dpos - curpos)
        ReDim _Preserve StorageArray(UBound(StorageArray) + 1) As String
        curpos = dpos + Len(delimiter)
        dpos = InStr(curpos, copy, delimiter)
    Loop
    StorageArray(UBound(StorageArray)) = Mid$(copy, curpos)
    ReDim _Preserve StorageArray(UBound(StorageArray)) As String
End Sub
 
 

BTW my recursive, now fixed, and non recursive get same results as Steve and Spriggsy's method but they start printing out immediately the list and count.

bplus · « **Reply #27 on:** November 09, 2021, 12:42:23 pm »

Ah! The slashes, can someone remind me which one Linux uses?

I don't think it matters for Windows.

SMcNeill · « **Reply #28 on:** November 09, 2021, 12:51:10 pm »

Quote from: bplus on November 09, 2021, 12:42:23 pm

Ah! The slashes, can someone remind me which one Linux uses?

I don't think it matters for Windows.

$If WIN Then
slash$ = "\"
$Else
slash$ = "/"
$End If

bplus · « **Reply #29 on:** November 09, 2021, 01:08:13 pm »

Quote from: SMcNeill on November 09, 2021, 06:22:25 am

See if this works without missing any files for you:

Code: QB64: [Select]
ReDim As String Dir(0), File(0)

GetLists "D:\repo\qb64", Dir(), File()
For i = 1 To UBound(Dir)
Print Dir(i),
Next
Print: Print
For i = 1 To UBound(File)
Print File(i),
Next

Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
' Thanks SNcNeill ! for a cross platform method to get file and directory lists
'put this block in main code section of your program close to top
'' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Declare CustomType Library ".\direntry"
Function load_dir& (s As String)
Function has_next_entry& ()
Sub close_dir ()
Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare

Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
Dim nam$, slash$
ReDim _Preserve DirList(100), FileList(100)
DirCount = 0: FileCount = 0
$If WIN Then
slash$ = "\"
$Else
slash$ = "/"
$End If
If Right$(SearchDirectory$, 1) <> "/" And Right$(SearchDirectory$, 1) <> "\" Then SearchDirectory$ = SearchDirectory$ + slash$

If load_dir(SearchDirectory + Chr$(0)) Then
Do
length = has_next_entry
If length > -1 Then
nam$ = Space$(length)
get_next_entry nam$, flags, file_size
If _DirExists(SearchDirectory + nam$) Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
DirList(DirCount) = nam$
ElseIf _FileExists(SearchDirectory + nam$) Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
FileList(FileCount) = nam$
Else 'This else should never actually trigger
Print "Unknown file found: "; SearchDirectory; slash$; nam$, _DirExists(nam$)
Sleep
End If
End If
Loop Until length = -1
End If
close_dir

ReDim _Preserve DirList(DirCount)
ReDim _Preserve FileList(FileCount)
End Sub

This removes the POSIX flag checking and relies on QB64's native _DIREXISTS and _FILEEXISTS to tell us which is a file and which is a directory. If it finds the files but misses identifying the files completely, you'll get a nice BEEP and message. OF course, if it misses the files completely, they just won't show up anywhere for us... :P

So this should work as GetLists replacement in the OP?
I will check and looks like Linux still being taken into consideration.

News:

Author Topic: Bas Files Count and List by Recursive Algorithm (Read 13931 times)

SpriggsySpriggs

Re: Bas Files Count and List by Recursive Algorithm

SMcNeill

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

SMcNeill

Re: Bas Files Count and List by Recursive Algorithm

SMcNeill

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

SMcNeill

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm

SMcNeill

Re: Bas Files Count and List by Recursive Algorithm

bplus

Re: Bas Files Count and List by Recursive Algorithm