Print Page - Bas Files Count and List by Recursive Algorithm

Title: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 04, 2021, 11:05:25 pm

Here is something that might actually be useful, temperamental as hell but I finally got results after several compromises:

I had to ChDir to the search Directory to get good results from the GetLists Subroutine. I had never noted that before but it turns out I did do that for Oh Interpreter and other places I successfully used the cross platform files retriever. Dang! It's so frustrating to think you've got something nailed down, go to use it 6 months later and stumble into problems.

Then Windows wont let me ChDir in allot of places where _DirExists so I couldn't just start looking from C:\ for bas files nor even from C:\users\me and my stuff! blah!
But it did work OK from my Desktop and my Downloads Folders where I learn tonight over 10,000 bas files reside.

Takes about 1 sec to do the downloads folder that had 2115 bas files.

Code: QB64: [Select]

_Title "Count BAS files from a start Directory" ' b+ 2021-11-04
 
' direntry.h needs to be in QB64.exe folder, see below for a commented copy
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
 
ReDim Shared BasList$(10000) 'store our Bas pathed Files here
Dim Shared GrandTotal As _Unsigned Long ' ha, ha not that many!
 
FullPathedDir$ = "C:\Users\marka\downloads" ' <<<<<<<<<<<<<  change this line to top directory of your search for
'                                                            best results use places where Windows lets you write bas files.
 
FindAndCountBasFileFrom FullPathedDir$
Print " Grand Total .bas ="; GrandTotal
Open FullPathedDir$ + "\Bas List.txt" For Output As #1
For i = 1 To GrandTotal
    Print #1, BasList$(i)
Next
Close #1
Print FullPathedDir$ + "\Bas List.txt file is ready."
 
 
Sub FindAndCountBasFileFrom (startDir$)
    If startDir$ <> "." And startDir$ <> ".." And _Trim$(startDir$) <> "" Then
        If Right$(startDir$, 1) <> "\" Then startDir$ = startDir$ + "\"
        If _DirExists(startDir$) Then ChDir startDir$ Else Exit Sub ' >>> There are allot of places where dir exists but cant CD to go!
        'Print "Changing Directory to "; startDir$; ""
        ReDim ds(0) As String, fs(0) As String
        GetLists startDir$, ds(), fs()
        'Print startDir$ + " .bas Files:"
        For i = LBound(fs) To UBound(fs)
            If UCase$(Right$(fs(i), 4)) = ".BAS" Then
                GrandTotal = GrandTotal + 1
                Print GrandTotal, startDir$ + fs(i)
                BasList$(GrandTotal) = startDir$ + fs(i)
                'If i Mod 20 = 19 Then Print "Press any to cont..": Sleep
            End If
        Next
        'Print
        'Print startDir$ + " Sub-Directories:  zzz...": Sleep
        For j = LBound(ds) To UBound(ds)
            If ds(j) <> "." And ds(j) <> ".." And _Trim$(ds(j)) <> "" Then
                newD$ = startDir$ + ds(j)
                'Print "Press any to FindAndCountBasFileFrom " + newD$ + "... zzz": Sleep
                FindAndCountBasFileFrom newD$
            End If
        Next
        'Print "Press any to cont...": Sleep
    End If
End Sub
 
Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
 
    '   !!! For this sub to work the _CWD has to be the Search Directory! !!!
 
    ' 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) + 1000)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then
                        ReDim _Preserve FileList(UBound(FileList) + 1000)
                        'Print Left$(SearchDirectory, Len(searchDiretory) - 1)
                        'getting allot of wierd misfires
                        If Left$(SearchDirectory, Len(searchDiretory) - 1) = "C:\" Then Exit Sub
                    End If
                    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
 
'  Remove comments below and save as direntry.h
' in your QB64.exe folder if you don't have it already
'=============================================================
 
'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>
 
'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;
 
'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;
 
'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
'  #define GetCurrentDir _getcwd
'#else
'  #define GetCurrentDir getcwd
'#endif
 
'int load_dir (char * path) {
'  struct dirent *pent;
'  struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}
 
'int has_next_entry () {
'  next_entry = readdir(pdir);
'  if (next_entry == NULL) return -1;
 
'  stat(next_entry->d_name, &statbuf1);
'  return strlen(next_entry->d_name);
'}
 
'void get_next_entry (char * nam, int * flags, int * file_size) {
'  strcpy(nam, next_entry->d_name);
'  if (S_ISDIR(statbuf1.st_mode)) {
'    *flags = IS_DIR_FLAG;
'  } else {
'    *flags = IS_FILE_FLAG;
'  }
'  *file_size = statbuf1.st_size;
'  return ;
'}
 
'void close_dir () {
'  closedir(pdir);
'  pdir = NULL;
'  return ;
'}
 
'int current_dir_length () {
'  GetCurrentDir(current_dir, sizeof(current_dir));
'  return strlen(current_dir);
'}
 
'void get_current_dir(char *dir) {
'  memcpy(dir, current_dir, strlen(current_dir));
'  return ;
'}
 
 

Theoretically this is cross platform, would non Windows users verify?

So how many bas files have you got laying around your computer?

Update: This code has nasty error in it and is missing allot of folders.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: Petr on November 05, 2021, 06:43:02 am

Quote

So how many bas files have you got laying around your computer?

Hi, just for curiosity - 7717 (but not all are my own sources)

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 05, 2021, 09:10:27 am

Thanks Petr, I can assume it's working for you too on Windows probably.

Yeah most my bas files are probably not mine, some are yours.

For Linux I am wondering if the slash is pointed the right way for paths, supposedly for Windows it doesn't matter.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 08, 2021, 12:50:26 pm

oops!

I started digging into a smaller directory count and found it missing folders from a certain point onward.

I don't know if GetLists is still buggy or just trying to use it for this recursive code.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: Cobalt on November 08, 2021, 02:02:43 pm

finds 2 files(in drive d:\, 3 files in drive E:\ and 0 files in c:\) then errors out with "PATH NOT FOUND" error.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 08, 2021, 02:31:23 pm

Well I never intended it to jump drives, probably should have. Do you think ChDir (without change drives also like we needed in DOS) could keep up with that?

GetLists routine needs to be in the Directory it's finding files and folders from = the compromise I am willing to accept to be able to do cross platform. No one else, including Spriggsy with PipeCom, has been able to produce simple File and Directory lists that one can use for navigation or as I am trying here: counting Bas Files in a directory and all it's subdirectories. (It's kinda odd because the IDE is doing it and very well, thank very much!, and I am assuming it uses something like the GetLists routine.)

Currently I am attempting a fix with Stack Techniques. I am pretty sure whatever is broken is from trying it with recursive calls. I am having no trouble navigating and finding files with GetLists in both TextFetch and the Oh Interpreter even after the QB64 v2.0 update, I've run both now with QB64 v 2.0. (Did have to fix Oh Interpreter in a couple of places.)

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: TempodiBasic on November 08, 2021, 02:37:05 pm

Hi Bplus
here my feedback from Windows 8.1 pro

[ This attachment cannot be displayed inline in 'Print Page' view ]

as you can see your application found more file than CMD : DIR *.BAS /S

What do I to think about it?

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill on November 08, 2021, 03:10:21 pm

Why use CHDIR? There's a lot of hidden and system only directories which won't let you into them, but you can still get a directory listing from them.

For example, this is a recursive routine which gets ALL the file and directories from a folder and its subfolders -- warning, this might take a while to run if you choose a directory with a zillion files such as the root directory of C:\. If you get tired of waiting, hit ESC and it'll dump what it's found so far to disk to and screen for you to view.

Code: QB64: [Select]

_Title "Count BAS files from a start Directory" ' b+ 2021-11-04
 
ReDim Shared BasList$(10000) 'store our Bas pathed Files here
 
ReDim As String Dir(0)
 
GetAll "C:\", Dir()
Open "DirList.txt" For Output As #1
For i = 1 To UBound(Dir)
    If _DirExists(Dir(i)) Then Color 7 Else Color 15
    Print #1, Dir(i)
    Print i, Dir(i)
Next
Close
 
 
Sub GetAll (Path As String, DirList() As String)
    If _KeyDown(27) Then Exit Sub
    ReDim tempDir(0) As String
    GetDir Path, tempDir()
    For i = 1 To UBound(tempDir)
        DirCount = UBound(DirList) + 1
        ReDim _Preserve DirList(DirCount)
        DirList(DirCount) = tempDir(i)
        If _DirExists(tempDir(i)) And Right$(tempDir(i), 1) <> "." Then
            DirList(DirCount) = DirList(DirCount) + "\"
            GetAll tempDir(i), DirList()
        End If
 
    Next
End Sub
 
 
Sub GetDir (SearchDirectory As String, DirList() As String)
    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$
    DirCount = UBound(DirList)
    If Right$(SearchDirectory, 1) = "\" Or Right$(SearchDirectory, 1) = "/" Then SearchDirectory = Left$(SearchDirectory, Len(SearchDirectory) - 1)
    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 Right$(nam$, 1) <> "." Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 1000)
                    DirList(DirCount) = SearchDirectory + "\" + nam$
                End If
            End If
        Loop Until length = -1
    End If
    close_dir
    ReDim _Preserve DirList(DirCount)
End Sub
 
'  Remove comments below and save as direntry.h
' in your QB64.exe folder if you don't have it already
'=============================================================
 
'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>
 
'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;
 
'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;
 
'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
'  #define GetCurrentDir _getcwd
'#else
'  #define GetCurrentDir getcwd
'#endif
 
'int load_dir (char * path) {
'  struct dirent *pent;
'  struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}
 
'int has_next_entry () {
'  next_entry = readdir(pdir);
'  if (next_entry == NULL) return -1;
 
'  stat(next_entry->d_name, &statbuf1);
'  return strlen(next_entry->d_name);
'}
 
'void get_next_entry (char * nam, int * flags, int * file_size) {
'  strcpy(nam, next_entry->d_name);
'  if (S_ISDIR(statbuf1.st_mode)) {
'    *flags = IS_DIR_FLAG;
'  } else {
'    *flags = IS_FILE_FLAG;
'  }
'  *file_size = statbuf1.st_size;
'  return ;
'}
 
'void close_dir () {
'  closedir(pdir);
'  pdir = NULL;
'  return ;
'}
 
'int current_dir_length () {
'  GetCurrentDir(current_dir, sizeof(current_dir));
'  return strlen(current_dir);
'}
 
'void get_current_dir(char *dir) {
'  memcpy(dir, current_dir, strlen(current_dir));
'  return ;
'}
 

Note that I've 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 it's not missing anything.

Note 2: This doesn't autoclear the old directory listing and builds upon it as you call it. If you're going to call the routine multiple times, reset your listing with a fresh ReDim As String Dir(0) before making the call to GetAll.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill on November 08, 2021, 03:26:59 pm

And to just see a list of all the BAS files which you have, the following should work:

Code: QB64: [Select]

_Title "Count BAS files from a start Directory" ' b+ 2021-11-04
 
ReDim Shared BasList$(100000) 'store our Bas pathed Files here
 
ReDim As String Dir(0)
 
GetAll "D:\", Dir()
Open "BasList.txt" For Output As #1
For i = 1 To UBound(Dir)
    If _DirExists(Dir(i)) Then Color 7 Else Color 15
    If _StriCmp(Right$(Dir(i), 4), ".bas") = 0 Then
        'it's a BAS file
        BasCount = BasCount + 1
        BasList$(BasCount) = Dir(i)
        Print BasCount, BasList$(BasCount)
        Print #1, BasCount, BasList$(BasCount)
    End If
Next
Close
 
 
Sub GetAll (Path As String, DirList() As String)
    If _KeyDown(27) Then Exit Sub
    ReDim tempDir(0) As String
    GetDir Path, tempDir()
    For i = 1 To UBound(tempDir)
        DirCount = UBound(DirList) + 1
        ReDim _Preserve DirList(DirCount)
        DirList(DirCount) = tempDir(i)
        If _DirExists(tempDir(i)) And Right$(tempDir(i), 1) <> "." Then
            DirList(DirCount) = DirList(DirCount) + "\"
            GetAll tempDir(i), DirList()
        End If
 
    Next
End Sub
 
 
Sub GetDir (SearchDirectory As String, DirList() As String)
    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$
    DirCount = UBound(DirList)
    If Right$(SearchDirectory, 1) = "\" Or Right$(SearchDirectory, 1) = "/" Then SearchDirectory = Left$(SearchDirectory, Len(SearchDirectory) - 1)
    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 Right$(nam$, 1) <> "." Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 1000)
                    DirList(DirCount) = SearchDirectory + "\" + nam$
                End If
            End If
        Loop Until length = -1
    End If
    close_dir
    ReDim _Preserve DirList(DirCount)
End Sub
 
'  Remove comments below and save as direntry.h
' in your QB64.exe folder if you don't have it already
'=============================================================
 
'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>
 
'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;
 
'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;
 
'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
'  #define GetCurrentDir _getcwd
'#else
'  #define GetCurrentDir getcwd
'#endif
 
'int load_dir (char * path) {
'  struct dirent *pent;
'  struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}
 
'int has_next_entry () {
'  next_entry = readdir(pdir);
'  if (next_entry == NULL) return -1;
 
'  stat(next_entry->d_name, &statbuf1);
'  return strlen(next_entry->d_name);
'}
 
'void get_next_entry (char * nam, int * flags, int * file_size) {
'  strcpy(nam, next_entry->d_name);
'  if (S_ISDIR(statbuf1.st_mode)) {
'    *flags = IS_DIR_FLAG;
'  } else {
'    *flags = IS_FILE_FLAG;
'  }
'  *file_size = statbuf1.st_size;
'  return ;
'}
 
'void close_dir () {
'  closedir(pdir);
'  pdir = NULL;
'  return ;
'}
 
'int current_dir_length () {
'  GetCurrentDir(current_dir, sizeof(current_dir));
'  return strlen(current_dir);
'}
 
'void get_current_dir(char *dir) {
'  memcpy(dir, current_dir, strlen(current_dir));
'  return ;
'}
 

No CHDIR involved. Just calls to our GetDir routine with the path updating as it goes.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 08, 2021, 04:25:10 pm

Quote from: TempodiBasic on November 08, 2021, 02:37:05 pm

Hi Bplus
here my feedback from Windows 8.1 pro

as you can see your application found more file than CMD : DIR *.BAS /S

What do I to think about it?

@TempodiBasic

Do you have some Basic files as .bas? Maybe your command only does capital BAS?

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 08, 2021, 04:38:25 pm

Quote from: SMcNeill on November 08, 2021, 03:26:59 pm

And to just see a list of all the BAS files which you have, the following should work:

Code: QB64: [Select]
_Title "Count BAS files from a start Directory" ' b+ 2021-11-04

ReDim Shared BasList$(100000) 'store our Bas pathed Files here

ReDim As String Dir(0)

GetAll "D:\", Dir()
Open "BasList.txt" For Output As #1
For i = 1 To UBound(Dir)
If _DirExists(Dir(i)) Then Color 7 Else Color 15
If _StriCmp(Right$(Dir(i), 4), ".bas") = 0 Then
'it's a BAS file
BasCount = BasCount + 1
BasList$(BasCount) = Dir(i)
Print BasCount, BasList$(BasCount)
Print #1, BasCount, BasList$(BasCount)
End If
Next
Close

Sub GetAll (Path As String, DirList() As String)
If _KeyDown(27) Then Exit Sub
ReDim tempDir(0) As String
GetDir Path, tempDir()
For i = 1 To UBound(tempDir)
DirCount = UBound(DirList) + 1
ReDim _Preserve DirList(DirCount)
DirList(DirCount) = tempDir(i)
If _DirExists(tempDir(i)) And Right$(tempDir(i), 1) <> "." Then
DirList(DirCount) = DirList(DirCount) + "\"
GetAll tempDir(i), DirList()
End If

Next
End Sub

Sub GetDir (SearchDirectory As String, DirList() As String)
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$
DirCount = UBound(DirList)
If Right$(SearchDirectory, 1) = "\" Or Right$(SearchDirectory, 1) = "/" Then SearchDirectory = Left$(SearchDirectory, Len(SearchDirectory) - 1)
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 Right$(nam$, 1) <> "." Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 1000)
DirList(DirCount) = SearchDirectory + "\" + nam$
End If
End If
Loop Until length = -1
End If
close_dir
ReDim _Preserve DirList(DirCount)
End Sub

' Remove comments below and save as direntry.h
' in your QB64.exe folder if you don't have it already
'=============================================================

'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>

'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;

'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;

'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
' #define GetCurrentDir _getcwd
'#else
' #define GetCurrentDir getcwd
'#endif

'int load_dir (char * path) {
' struct dirent *pent;
' struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}

'int has_next_entry () {
' next_entry = readdir(pdir);
' if (next_entry == NULL) return -1;

' stat(next_entry->d_name, &statbuf1);
' return strlen(next_entry->d_name);
'}

'void get_next_entry (char * nam, int * flags, int * file_size) {
' strcpy(nam, next_entry->d_name);
' if (S_ISDIR(statbuf1.st_mode)) {
' *flags = IS_DIR_FLAG;
' } else {
' *flags = IS_FILE_FLAG;
' }
' *file_size = statbuf1.st_size;
' return ;
'}

'void close_dir () {
' closedir(pdir);
' pdir = NULL;
' return ;
'}

'int current_dir_length () {
' GetCurrentDir(current_dir, sizeof(current_dir));
' return strlen(current_dir);
'}

'void get_current_dir(char *dir) {
' memcpy(dir, current_dir, strlen(current_dir));
' return ;
'}

No CHDIR involved. Just calls to our GetDir routine with the path updating as it goes.

@SMcNeill

Thanks so much for this! Now I have confirmation that I have fixed my stuff. Though obviously I'd prefer to do the whole thing without the ChDir as you have.

There is some slight difference between GetLists from Oh Interpreter where it was working and here in OP that I've yet to pin down. Turns out I was using a Windows Only Technique for TextFetch.

I have 11,843 Bas files on my Desktop alone not 8,000+- I have 3 backup copies at least of all my BAS work files in various QB64 version numbers. I get this number from your code and the one I fixed with Oh Interpreter GetLists AND used a Non Recursive Stack because something dies in recursive version at 8080.

I will slowly get to using your much better version but first I am curious what the heck was the difference in GetLists.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 08, 2021, 07:16:32 pm

Have to make Steve's solution Best Answer it so much better than recursive!

Just a tiny mod to put the file that it writes in the top directory of your search and count and list.

Code: QB64: [Select]

FullPathedDir$ = "C:\Users\marka\Desktop\QB64 work"
'GetAll "D:\", Dir()
GetAll FullPathedDir$, Dir()
Open FullPathedDir$ + "\Count BasList SMcNeill.txt" For Output As #1 ' <put this in the directory we are doing
 

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill on November 08, 2021, 07:55:50 pm

Quote from: bplus on November 08, 2021, 07:16:32 pm

Have to make Steve's solution Best Answer it so much better than recursive!

Just a tiny mod to put the file that it writes in the top directory of your search and count and list.
Code: QB64: [Select]
FullPathedDir$ = "C:\Users\marka\Desktop\QB64 work"
'GetAll "D:\", Dir()
GetAll FullPathedDir$, Dir()
Open FullPathedDir$ + "\Count BasList SMcNeill.txt" For Output As #1 ' <put this in the directory we are doing

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

And remember: ReDim As String Dir(0) before making the call to GetAll if you're going to call it again. Reset your UBOUND to 0.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SpriggsySpriggs on November 08, 2021, 08:10:13 pm

I'd like to submit a simple alternative, if I may. I know this isn't recursive but I'm too lazy to do that right now.

Code: QB64 $NOPREFIX: [Select]

Option Explicit
$NoPrefix
$Console:Only
 
Type FILETIME
    As Unsigned Long dwLowDateTime, dwHighDateTime
End Type
 
Type WIN32_FIND_DATA
    As Unsigned Long dwFileAttributes
    As FILETIME ftCreationTime, ftLastAccessTime, ftLastWriteTime
    As Unsigned Long nFileSizeHigh, nFileSizeLow, dwReserved0, dwReserved1
    As String * 260 cFileName
    As String * 14 cAlternateFileName
    As Unsigned Long dwFileType, dwCreatorType
    As Unsigned Integer wFinderFlags
End Type
 
Declare CustomType Library
    Function FindFirstFile%& (ByVal lpFileName As Offset, Byval lpFindFileData As Offset)
    Function FindNextFile& (ByVal hFindFile As Offset, Byval lpFindFileData As Offset)
    Sub FindClose (ByVal hFindFile As Offset)
End Declare
 
Dim As Offset find
Dim As String searchTerm
Dim As WIN32_FIND_DATA attr
 
searchTerm = ".\*.bas" + Chr$(0)
 
find = FindFirstFile(Offset(searchTerm), Offset(attr))
 
If find <> -1 And find <> 0 Then
    Do
        Print Mid$(attr.cFileName, 1, InStr(attr.cFileName, Chr$(0)) - 1)
    Loop While FindNextFile(find, Offset(attr))
End If
 
FindClose find

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SpriggsySpriggs on November 08, 2021, 08:19:19 pm

Quote from: bplus on November 08, 2021, 04:25:10 pm

@TempodiBasic

Do you have some Basic files as .bas? Maybe your command only does capital BAS?

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.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SpriggsySpriggs 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

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill 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.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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):
[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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!

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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:
[ This attachment cannot be displayed inline in 'Print Page' view ]

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

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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
 

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: 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.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: 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

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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...

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill 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. ;)

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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...

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: 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.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill 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

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus 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.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill on November 09, 2021, 01:12:52 pm

It should work just as you're used to, with the addition of an error message if something slides past detection as either file or directory. (And you shouldn't need to CHDIR for it to work, I wouldn't think.)

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SpriggsySpriggs on November 09, 2021, 10:11:24 pm

All I was showing was how you can do a recursive search with PowerShell. It isn't necessarily only searching files. It's searching based on the string. So it will return anything that matches the string, no matter if it is a file or a folder. It is interesting that one would have a folder with an extension in the name, however. I think the PowerShell call could be edited to do only files.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 10, 2021, 06:36:16 pm

OK I have 5 programs that count and list Bas files from a start Directory, they are described with a couple times I got testing the programs. Turns out when I fixed the original recursive code, it turned in the fastest times but Steve's code is checking everything which I think accounts for difference in times, more than double.

Anyway here is code and comments tested on my old Windows 10 laptop 64-bit with a Desktop containing over 11,850 files. Of course you will have different results.

PS to test in your system edit a couple of lines near the top of each program specifying the path and the pathed file list file name to use. Oh, also if direntry.h is not in the same folder as QB64.exe, there is a copy that is commented out at the bottom of programs that use it.

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 16, 2021, 02:36:31 pm

Update: I was working on clearing all these experiments off my Desktop and retesting them in my Downloads Folder.

Big snag with all SMcNeills code because he was using Integer Type for FileCount and DirCount. Turns out I had a folder with over 40,000 files and I got subscript error repeated over and over for that Folder.

Also after fixing that with Long Type, I ran into a problem file caught by Steve's code "that should never happen", here is a snapshot of that file:

Here is revised GetLists subroutine:

Code: QB64: [Select]

' fixed 2021-11-16 for folders or files OVER 32,000+ Integer Range
' ref 2021-11-09 Steve update GetLists:  https://www.qb64.org/forum/index.php?topic=4360.msg138031#msg138031
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
 
    ' fix 2021-11-16 I have a folder in Downloads that is over 40,000 files mostly HTML which caused subscript errors
    ' change DirCount and FileCount to Long from Integer
    Dim flags As Long, file_size As Long, DirCount As Long, FileCount As Long, 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: Print: Print "zzz...  Unknown file found: "; SearchDirectory; slash$; nam$, _DirExists(nam$)
                    Beep: Sleep ' alert the user to
                End If
            End If
        Loop Until length = -1
    End If
    close_dir
 
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub
 

copy of direntry.h to put in same folder as your QB64.exe

Code: [Select]

#include <dirent.h>
#include <sys/stat.h>
#include <unistd.h>

const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;

DIR *pdir;
struct dirent *next_entry;
struct stat statbuf1;

char current_dir[FILENAME_MAX];
#ifdef QB64_WINDOWS
  #define GetCurrentDir _getcwd
#else
  #define GetCurrentDir getcwd
#endif

int load_dir (char * path) {
  struct dirent *pent;
  struct stat statbuf1;
//Open current directory
pdir = opendir(path);
if (!pdir) {
return 0; //Didn't open
}
return -1;
}

int has_next_entry () {
  next_entry = readdir(pdir);
  if (next_entry == NULL) return -1;
  
  stat(next_entry->d_name, &statbuf1);
  return strlen(next_entry->d_name);
}

void get_next_entry (char * nam, int * flags, int * file_size) {
  strcpy(nam, next_entry->d_name);
  if (S_ISDIR(statbuf1.st_mode)) {
    *flags = IS_DIR_FLAG;
  } else {
    *flags = IS_FILE_FLAG;
  }
  *file_size = statbuf1.st_size;
  return ;
}

void close_dir () {
  closedir(pdir);
  pdir = NULL;
  return ;
}

int current_dir_length () {
  GetCurrentDir(current_dir, sizeof(current_dir));
  return strlen(current_dir);
}

void get_current_dir(char *dir) {
  memcpy(dir, current_dir, strlen(current_dir));
  return ;
}

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: SMcNeill on November 16, 2021, 05:59:00 pm

Question: How'd you generate two slashes in the filename? And if it's not a file, nor a directory, what is it? Does it even exist, or is that some false positive it generated somehow?

Title: Re: Bas Files Count and List by Recursive Algorithm
Post by: bplus on November 16, 2021, 07:46:06 pm

I think I was trying out a Wiki access from something by you @SMcNeill

A view from InForm Project:

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on November 04, 2021, 11:05:25 pm