Posted: Sun Apr 25, 2004 10:27 pm
By the way: nice peace of program language you all've put togheter.
Just keep on supporting it and the community will grow enormous
Just keep on supporting it and the community will grow enormous
http://www.purebasic.com
https://www.purebasic.fr/english/
Also as directoryname?just wanna say that ".hello" is a valid on my win98 se too
Yep also as a dir.name, but not a single "." so, your last code should be okayThe seperator wrote: Also as directoryname?
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.
LOL.. : And ThanksFangbeast wrote: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).
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
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.")
Most likely the debug. Try the new and improved.oO0XX0Oo wrote: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
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
Code: Select all
fd\Options = #FD_RECURSE | #FD_FILES | #FD_FULLPATH