Find all files in one folder (or list folders in subfolder)

[The seperator]

By the way: nice peace of program language you all've put togheter.
Just keep on supporting it and the community will grow enormous

[The seperator]

just wanna say that ".hello" is a valid on my win98 se too

Also as directoryname?

[Henrik]

oOps forgot..
Wellcome Seperator

[Henrik]

Also as directoryname?

Yep also as a dir.name, but not a single "." so, your last code should be okay
Edit:
Im gonna take that nice littel snip btw can be very handy.
Thanks


Best Regards
Henrik

[blueznl]

... you don't wanna see what's valid on a unicode windows (running win98cn (chinese) on my wife's pc)

[GenRabbit]

Ops.. Activating a very old thread.. Anyway
I was looking for something like "The seperators" Filefolder lister, but I could not get it to compile. So buy using the trick I found in his code I set out to rewrite it for this more modern day;

Code: Select all

EnableExplicit
CompilerSelect #PB_Compiler_Processor
    CompilerCase #PB_Processor_x86
        #Length_Integer = 4
    CompilerCase #PB_Processor_x64
        #Length_Integer = 8
CompilerEndSelect

CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
        #FolderDelimiter$ = "\"
    CompilerDefault
        #FolderDelimiter$ = "/"
CompilerEndSelect

CompilerIf #PB_Compiler_Unicode
    #Length_Char = 2
CompilerElse
    #Length_Char = 1
CompilerEndIf

#OrigFolderRoot$ = "F:\Projects\Modding\ExtractedFiles\Beyond reach" ; Change to whatever you wish.
#MemoryBlockSizeStart = 1024*1024 ; 1MB
#MemoryBlockSizeADD  = 1024*1024 ; 1MB

Enumeration ERRMSG_ 10 Step 5
    #ERRMSG_OUT_OF_MEMORY
EndEnumeration

EnumerationBinary
    #FD_RECURSIVE
    #FD_FOLDERS         ; Only Foldername
    #FD_FILES           ; Only Filename
EndEnumeration

Structure ReturnDir                
    *addresse
    FileDataSize.i
    FileDataBlockSize.i
    FileDataBlockSizeAdd.i
    Options.w
EndStructure                
Define rd.ReturnDir

; Strings
Define.s TempName, RootFolder, SubFolder
; Integers
Define.i TempLength

Procedure.i StoreResult(FilePathOrFilename.s, *Sr.ReturnDir)
    Protected *PathMapNew
    Protected.i LengthToAdd
    Protected.i TempLength = (Len(FilePathOrFilename) + 1) * #Length_Char
    If (*sr\FileDataSize + TempLength) >= *sr\FileDataBlockSize
        ; To small block. Time to increase
        If *sr\FileDataBlockSizeAdd > TempLength
            LengthToAdd = *sr\FileDataBlockSizeAdd
        Else
            LengthToAdd = TempLength
        EndIf
        
        *PathMapNew = ReAllocateMemory(*sr\addresse, *sr\FileDataBlockSize + LengthToAdd)
        If *PathMapNew
            *sr\addresse = *PathMapNew
            *sr\FileDataBlockSize + LengthToAdd
        Else
            ProcedureReturn #ERRMSG_OUT_OF_MEMORY
        EndIf
    EndIf    
    PokeS(*sr\addresse + *sr\FileDataSize,FilePathOrFilename)
    *sr\FileDataSize + TempLength
    ProcedureReturn 0
EndProcedure

Procedure.i RecurseDir(RootFolder.s, PresentRoot.s, *FileBlock.ReturnDir)
    Protected.i ExaDir, TempLength
    Protected.i *PathMapNew
    Protected.s TempName
    Protected.i ForcedQuit
    ExaDir = ExamineDirectory(#PB_Any, RootFolder,"*.*")
    If ExaDir
        While NextDirectoryEntry(ExaDir)
            Select DirectoryEntryType(ExaDir)
                ;--- Folder
                Case #PB_DirectoryEntry_Directory
                    TempName = DirectoryEntryName(ExaDir)
                    If (TempName <> ".") And (TempName <> "..")
                        If (*FileBlock\Options & #FD_RECURSIVE)
                            ForcedQuit = RecurseDir(RootFolder + TempName + #FolderDelimiter$, PresentRoot + TempName + #FolderDelimiter$, *FileBlock)
                            If ForcedQuit
                                Break
                            EndIf
                        EndIf        
                        If *FileBlock\Options & #FD_FOLDERS
                            ForcedQuit = StoreResult(PresentRoot + TempName + #FolderDelimiter$, *FileBlock)
                        EndIf
                        If ForcedQuit
                            Break
                        EndIf
                    EndIf                 
                ;--- File
                Case #PB_DirectoryEntry_File
                    TempName = DirectoryEntryName(ExaDir)
                    If *FileBlock\Options & #FD_FILES
                            ForcedQuit = StoreResult(TempName, *FileBlock)
                    ElseIf Not *FileBlock\Options & #FD_FOLDERS
                            ForcedQuit = StoreResult(PresentRoot + TempName, *FileBlock)
                    EndIf
            EndSelect
            If ForcedQuit
                Break
            EndIf
        Wend
        FinishDirectory(ExaDir)
    EndIf
    ProcedureReturn ForcedQuit
EndProcedure                

RootFolder = PathRequester("Mod Root.",#OrigFolderRoot$)
SubFolder = "" ; "" ; RootFolder

If Len(RootFolder)
    rd\addresse = AllocateMemory(#MemoryBlockSizeStart)
    rd\FileDataBlockSize = #MemoryBlockSizeStart
    rd\FileDataSize = 0
    rd\FileDataBlockSizeAdd = #MemoryBlockSizeADD
    rd\Options = #FD_RECURSIVE
    
    If RecurseDir(RootFolder, SubFolder, @rd) = 0
        ; ************* Add your own Code here - Below
        Define.i x
        If CreateFile(0,RootFolder + "Result.txt")
            While rd\FileDataSize > x
                TempName = PeekS(rd\addresse + x, -1, #PB_Unicode)
                TempLength = (Len(TempName) + 1) * #Length_Char
                WriteStringN(0, TempName, #PB_Ascii)
                x + TempLength
            Wend
            CloseFile(0)
        EndIf
        ; ************* Add your own Code here - Above
    Else    
        MessageRequester("Error.","Something went Shit..")
        
    EndIf
    FreeMemory(rd\addresse)
EndIf

Here it is for those that need something like this but cant find it anywhere.

[Fangbeast]

Wow!! 13 years is a record for necroposting and lord Zool will be pleased as his minions rise!!

Okay, so I need some coffee. Good code GenRabbit and it hurts my brain (heheheh, waiting for srod to insult me now).

There is a pb wiki somewhere or a rosetta page where it should be added I think. Plus, I think the pb code library has been revived so you might be able to add it to that with examples.

Good job. Hurts my brain.

[GenRabbit]

Wow!! 13 years is a record for necroposting and lord Zool will be pleased as his minions rise!!

Okay, so I need some coffee. Good code GenRabbit and it hurts my brain (heheheh, waiting for srod to insult me now).

LOL.. : And Thanks

[davido]

@GenRabbit ,
Phenomenal speed!!
I'm very pleased you resurrected this old thread.
Thank you

[oO0XX0Oo]

@GenRabbit

Thanks for providing the code!

Damn it, it's really incredible fast

[GenRabbit]

Updated Version:

What does the update bring to the table?
- Returns Number of files (\Files)
- Returns Number of folders (\Folders)
- If \FileDataBlockSizeAdd is smaller than the string it will add, It will neglect the \FileDataBlockSizeAdd and instead add the minimum of allocated space it will need.

If you want the program to return full path of files and folders, rather than the short one;
Change this;
RecurseDir(RootFolder, SubFolder, @rd)
To this;
RecurseDir(RootFolder, RootFolder, @rd)

Code: Select all

EnableExplicit
CompilerSelect #PB_Compiler_Processor
    CompilerCase #PB_Processor_x86
        #Length_Integer = 4
    CompilerCase #PB_Processor_x64
        #Length_Integer = 8
CompilerEndSelect

CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
        #FolderDelimiter$ = "\"
    CompilerDefault
        #FolderDelimiter$ = "/"
CompilerEndSelect

CompilerIf #PB_Compiler_Unicode
    #Length_Char = 2
CompilerElse
    #Length_Char = 1
CompilerEndIf

#OrigFolderRoot$ = "F:\Projects\Modding\ExtractedFiles\Beyond reach" ; Change to whatever you wish.
#MemoryBlockSizeStart = 1024*1024 ; 1MB
#MemoryBlockSizeADD  = 1024*1024 ; 1MB
Enumeration ERRMSG_ 10 Step 5
    #ERRMSG_OUT_OF_MEMORY
EndEnumeration

EnumerationBinary
    #FD_RECURSE
    #FD_FOLDERS         ; Only Foldername
    #FD_FILES           ; Only Filename
EndEnumeration

Structure ReturnDir                
    *addresse
    FileDataSize.i
    FileDataBlockSize.i
    FileDataBlockSizeAdd.i
    Options.w
    Files.i
    Folders.i
EndStructure                
Define rd.ReturnDir

; Strings
Define.s TempName, RootFolder, SubFolder
; Integers
Define.i TempLength

Procedure.i StoreResult(FilePathOrFilename.s, *Sr.ReturnDir)
    Protected *PathMapNew
    Protected.i LengthToAdd
    Protected.i TempLength = (Len(FilePathOrFilename) + 1) * #Length_Char
    If (*sr\FileDataSize + TempLength) >= *sr\FileDataBlockSize
        ; To small block. Time to increase
        If *sr\FileDataBlockSizeAdd > TempLength
            LengthToAdd = *sr\FileDataBlockSizeAdd
        Else
            LengthToAdd = TempLength
        EndIf
        
        *PathMapNew = ReAllocateMemory(*sr\addresse, *sr\FileDataBlockSize + LengthToAdd)
        If *PathMapNew
            *sr\addresse = *PathMapNew
            *sr\FileDataBlockSize + LengthToAdd
        Else
            ProcedureReturn #ERRMSG_OUT_OF_MEMORY
        EndIf
    EndIf    
    PokeS(*sr\addresse + *sr\FileDataSize,FilePathOrFilename)
    *sr\FileDataSize + TempLength
    ProcedureReturn 0
EndProcedure

Procedure.i RecurseDir(RootFolder.s, PresentRoot.s, *FileBlock.ReturnDir)
    Protected.i ExaDir, TempLength
    Protected.i *PathMapNew
    Protected.s TempName
    Protected.i ForcedQuit
    ExaDir = ExamineDirectory(#PB_Any, RootFolder,"*.*")
    If ExaDir
        While NextDirectoryEntry(ExaDir)
            Select DirectoryEntryType(ExaDir)
                ;--- Folder
                Case #PB_DirectoryEntry_Directory
                    TempName = DirectoryEntryName(ExaDir)
                    If (TempName <> ".") And (TempName <> "..")
                        *FileBlock\Folders + 1
                        If (*FileBlock\Options & #FD_RECURSE)
                            ForcedQuit = RecurseDir(RootFolder + TempName + #FolderDelimiter$, PresentRoot + TempName + #FolderDelimiter$, *FileBlock)
                            If ForcedQuit
                                Break
                            EndIf
                        EndIf        
                        If *FileBlock\Options & #FD_FOLDERS
                            ForcedQuit = StoreResult(PresentRoot + TempName + #FolderDelimiter$, *FileBlock)
                        EndIf
                        If ForcedQuit
                            Break
                        EndIf
                    EndIf                 
                ;--- File
                Case #PB_DirectoryEntry_File
                    TempName = DirectoryEntryName(ExaDir)
                    *FileBlock\Files + 1
                    If *FileBlock\Options & #FD_FILES
                            ForcedQuit = StoreResult(TempName, *FileBlock)
                    ElseIf Not *FileBlock\Options & #FD_FOLDERS
                            ForcedQuit = StoreResult(PresentRoot + TempName, *FileBlock)
                    EndIf
            EndSelect
            If ForcedQuit
                Break
            EndIf
        Wend
        FinishDirectory(ExaDir)
    EndIf
    ProcedureReturn ForcedQuit
EndProcedure                

RootFolder = PathRequester("Mod Root.",#OrigFolderRoot$)
SubFolder = "" ; "" ; RootFolder

If Len(RootFolder)
    rd\addresse = AllocateMemory(#MemoryBlockSizeStart)
    rd\FileDataBlockSize = #MemoryBlockSizeStart
    rd\FileDataSize = 0
    rd\FileDataBlockSizeAdd = 0
    rd\Options = #FD_RECURSE
    rd\Files = 0
    rd\Folders = 0
    If RecurseDir(RootFolder, SubFolder, @rd) = 0
        ; ************* Add your own Code here - Below
        Define.i x
        If CreateFile(0,RootFolder + "Result.txt")
            While rd\FileDataSize > x
                TempName = "Del " + #DQUOTE$ + PeekS(rd\addresse + x, -1, #PB_Unicode) + #DQUOTE$
                TempName = PeekS(rd\addresse + x, -1, #PB_Unicode)
                TempLength = (Len(TempName) + 1) * #Length_Char
                WriteStringN(0, "Del " + #DQUOTE$ + TempName + #DQUOTE$, #PB_Ascii)
                x + TempLength
            Wend
            CloseFile(0)
        EndIf
        ; ************* Add your own Code here - Above
    Else    
        MessageRequester("Error.","Something went Shit..")
        
    EndIf
    Debug "Files: " + Str(rd\files)
    Debug "Folders: " + Str(rd\Folders)
    FreeMemory(rd\addresse)
EndIf

[oO0XX0Oo]

Thanks for the updated version. Do you see the same slowdown as I?

Folder with 54.885 files and 7911 folders on a fast SSD

Previous version: 995ms
New version: 11880ms

[davido]

@GenRabbit,
Thank you for the update.

Works on both my Mac and PC.

It works surprisingly quickly with the debugger on, however, it is faster with the debugger switched off.
Could I suggest that you replace the debug lines with something like:

Code: Select all

Define dt.i = ElapsedMilliseconds()
If Len(RootFolder)
    rd\addresse = AllocateMemory(#MemoryBlockSizeStart)
    rd\FileDataBlockSize = #MemoryBlockSizeStart
    rd\FileDataSize = 0
    rd\FileDataBlockSizeAdd = 0
    rd\Options = #FD_RECURSE
    rd\Files = 0
    rd\Folders = 0
    If RecurseDir(RootFolder, SubFolder, @rd) = 0
        ; ************* Add your own Code here - Below
        Define.i x
        If CreateFile(0,RootFolder + "Result.txt")
            While rd\FileDataSize > x
                TempName = "Del " + #DQUOTE$ + PeekS(rd\addresse + x, -1, #PB_Unicode) + #DQUOTE$
                TempName = PeekS(rd\addresse + x, -1, #PB_Unicode)
                TempLength = (Len(TempName) + 1) * #Length_Char
                WriteStringN(0, "Del " + #DQUOTE$ + TempName + #DQUOTE$, #PB_Ascii)
                x + TempLength
            Wend
            CloseFile(0)
        EndIf
        ; ************* Add your own Code here - Above
    Else    
        MessageRequester("Error.","Something went Shit..")
        
      EndIf
      MessageRequester("Test!","Files: " + Str(rd\files) + " Folders: " + Str(rd\Folders) + " in " + Str(ElapsedMilliseconds() - dt) + "ms.")

Have you considered making this as a Module?

[GenRabbit]

Thanks for the updated version. Do you see the same slowdown as I?

Folder with 54.885 files and 7911 folders on a fast SSD

Previous version: 995ms
New version: 11880ms

Most likely the debug. Try the new and improved.
5129 files, 149 folders 10ms here

Latest Version. Removed the "Debug", added timing as proposed by Davido. (timing is started after Choosed a path)

Davido; What do you mean by module?

Only three Variables has to be set now before calling it;
fd\addresse ; this is the memory block. If you don't set it, it will return 15 (#ERRMSG_MEMORY_NOT_ALLOCATED)
remember to free up the memory when its not needed anymore

fd\FileDataBlockSizeAdd ; The numbers of bytes to add if memory allocated is to small. Its optional. If you don't. It will add memory everytime a new string is added(added is the size of the zero terminated string). This will slow it down mostly ALOT. Haven't tested it. Advisable. If large amount of files. Go for minimum 1MB. (1024*1024)

fd\Options ; here you set the flags. Example (#FD_RECURSE | #FD_FOLDERS | #FD_FULLPATH)

The earlier versions started directly into the Recursedir. This is changed to reduce the amount of values you have to set before calling it
Now the first part is FileDirectory

Before RecurseDir(RootFolder.s, PresentRoot.s, *FileBlock.ReturnDir)
Now : FileDirectory(RootFolder, @fd)

I changed rd/Fileblock etc and run with FD all over for easier debugging.



This includes cleaned up code and better explanation of what different flags do and such

Code: Select all

EnableExplicit
CompilerSelect #PB_Compiler_Processor
    CompilerCase #PB_Processor_x86
        #Length_Integer = 4
    CompilerCase #PB_Processor_x64
        #Length_Integer = 8
CompilerEndSelect

CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
        #FolderDelimiter$ = "\"
    CompilerDefault
        #FolderDelimiter$ = "/"
CompilerEndSelect

CompilerIf #PB_Compiler_Unicode
    #Length_Char = 2
CompilerElse
    #Length_Char = 1
CompilerEndIf

;--- Constants for testing
#OrigFolderRoot$ = "F:\Projects\Modding\ExtractedFiles\Beyond reach"
#MemoryBlockSizeStart = 1024 * 1024 ; Allocated memory 1MB
#MemoryBlockSizeAdd = 1024 * 1024 ; Allocated memory 1MB
;--- Error Flag
Enumeration ERRMSG_ 10 Step 5
    #ERRMSG_OUT_OF_MEMORY
    #ERRMSG_MEMORY_NOT_ALLOCATED
EndEnumeration

;--- Flags
EnumerationBinary
    #FD_RECURSE
    #FD_FOLDERS         ; Only Foldername
    #FD_FILES           ; Only Filename
    #FD_FULLPATH        ; Fullpath?
EndEnumeration

;--- Structure
Structure ReturnDir                
    *addresse
    FileDataSize.i
    FileDataBlockSize.i
    FileDataBlockSizeAdd.i
    Options.w
    Files.i
    Folders.i
EndStructure                

Procedure.i StoreResult(FilePathOrFilename.s, *Sr.ReturnDir)
    Protected *PathMapNew
    Protected.i LengthToAdd
    Protected.i TempLength = (Len(FilePathOrFilename) + 1) * #Length_Char
    If (*sr\FileDataSize + TempLength) >= *sr\FileDataBlockSize
        ; To small block. Time to increase
        If *sr\FileDataBlockSizeAdd > TempLength
            LengthToAdd = *sr\FileDataBlockSizeAdd
        Else
            LengthToAdd = TempLength
        EndIf
        
        *PathMapNew = ReAllocateMemory(*sr\addresse, *sr\FileDataBlockSize + LengthToAdd)
        If *PathMapNew
            *sr\addresse = *PathMapNew
            *sr\FileDataBlockSize + LengthToAdd
        Else
            ProcedureReturn #ERRMSG_OUT_OF_MEMORY
        EndIf
    EndIf    
    PokeS(*sr\addresse + *sr\FileDataSize,FilePathOrFilename)
    *sr\FileDataSize + TempLength
    ProcedureReturn 0
EndProcedure

Procedure.i RecurseDir(RootFolder.s, PresentRoot.s, *Fd.ReturnDir)
    Protected.i ExaDir, TempLength
    Protected.i *PathMapNew
    Protected.s TempName
    Protected.i ForcedQuit
    ExaDir = ExamineDirectory(#PB_Any, RootFolder,"*.*")
    If ExaDir
        While NextDirectoryEntry(ExaDir)
            Select DirectoryEntryType(ExaDir)
                ;--- Folder
                Case #PB_DirectoryEntry_Directory
                    TempName = DirectoryEntryName(ExaDir)
                    If (TempName <> ".") And (TempName <> "..")
                        *Fd\Folders + 1
                        If (*Fd\Options & #FD_RECURSE)
                            ForcedQuit = RecurseDir(RootFolder + TempName + #FolderDelimiter$, PresentRoot + TempName + #FolderDelimiter$, *Fd)
                            If ForcedQuit
                                Break
                            EndIf
                        EndIf        
                        If *Fd\Options & #FD_FOLDERS
                            ForcedQuit = StoreResult(PresentRoot + TempName + #FolderDelimiter$, *Fd)
                        EndIf
                        If ForcedQuit
                            Break
                        EndIf
                    EndIf                 
                ;--- File
                Case #PB_DirectoryEntry_File
                    TempName = DirectoryEntryName(ExaDir)
                    *Fd\Files + 1
                    If *Fd\Options & #FD_FILES
                            ForcedQuit = StoreResult(TempName, *Fd)
                    ElseIf Not *Fd\Options & #FD_FOLDERS
                            ForcedQuit = StoreResult(PresentRoot + TempName, *Fd)
                    EndIf
            EndSelect
            If ForcedQuit
                Break
            EndIf
        Wend
        FinishDirectory(ExaDir)
    EndIf
    ProcedureReturn ForcedQuit
EndProcedure                

Procedure.i FileDirectory(RootFolder.s, *fd.ReturnDir)
    ; Initialize values 
    Protected.s subfolder
    If *fd\addresse
        *fd\Files = 0
        *fd\Folders = 0
        *fd\FileDataSize = 0
        *fd\FileDataBlockSize = MemorySize(*fd\addresse) ; Sets \FileDataBlocksize to the Size of the Allocated buffer.
        If *fd\Options & #FD_FULLPATH
            SubFolder = RootFolder
        EndIf
        ProcedureReturn RecurseDir(RootFolder, SubFolder, *fd)
    Else
        ProcedureReturn #ERRMSG_MEMORY_NOT_ALLOCATED
    EndIf
EndProcedure

;--- local Global Strings variables
Define fd.ReturnDir
; Strings
Define.s TempName, RootFolder
; Integers
Define.i TempLength
;-- Program starts
RootFolder = PathRequester("Mod Root.",#OrigFolderRoot$)
Define dt.i = ElapsedMilliseconds()
If Len(RootFolder)
    ;--- Program variables which must be set
    fd\addresse = AllocateMemory(#MemoryBlockSizeStart)    ; allocate memory for Filenames and folder names.
    ; FileDataBlockSizeAdd:
    ; The amount of memory to allocate to the already allocated memory (Optional, Advisable.)
    fd\FileDataBlockSizeAdd = #MemoryBlockSizeAdd 
    ; Options
    ; Flags for work operation.
    ; * #FD_RECURSE *
    ; Also take subdirectories
    ; * #FD_FOLDERS *
    ; Only stores foldernames
    ; * #FD_FILES *
    ; Only stores Filenames
    ; * #FD_FULLPATH *
    ; Files\Folders are stored with fullpath. (#FD_FILES will make this obsolete)
    fd\Options = #FD_RECURSE | #FD_FULLPATH
    If FileDirectory(RootFolder, @fd) = 0
        ; ************* Add your own Code here - Below
        MessageRequester("Test!","Files: " + Str(fd\files) + " Folders: " + Str(fd\Folders) + " in " + Str(ElapsedMilliseconds() - dt) + "ms.")
        Define.i x
        If CreateFile(0,RootFolder + "Result.txt")
            While fd\FileDataSize > x
                TempName = "Del " + #DQUOTE$ + PeekS(fd\addresse + x, -1, #PB_Unicode) + #DQUOTE$
                TempName = PeekS(fd\addresse + x, -1, #PB_Unicode)
                TempLength = (Len(TempName) + 1) * #Length_Char
                WriteStringN(0, "Del " + #DQUOTE$ + TempName + #DQUOTE$, #PB_Ascii)
                x + TempLength
            Wend
            CloseFile(0)
        EndIf
        ; ************* Add your own Code here - Above
    Else    
        MessageRequester("Error.","Something went Shit..")
        
    EndIf
    FreeMemory(fd\addresse)
EndIf

*Edit: Updated some decription in the code(fd\Options)*

[oO0XX0Oo]

The new version is even faster than the old one, nice work!

A bug, though...

Code: Select all

fd\Options = #FD_RECURSE | #FD_FILES | #FD_FULLPATH

Even with #FD_FULLPATH set, the Result.txt file contains only file names, no paths?