habe ich den NextLevel in PureBasic erreicht.
Da ich keine so umfangreiche FileList-Funktion gefunden habe, wie ich mir das
vorgestellt hatte (Einstellung der Suchtiefe der Verzeichnisse, Umfangreiche Filterfunktionen), musste ich selbst ran!
Es funktioniert mittlerweile gut, ich bin aber noch nicht ganz zufrieden.
Todo:
1. Problem mit den Pattern$ der ExamineDirectory() Funktion. Wird ein Pattern angegeben (z.B. *.txt),
dann werden keine Verzeichnisse mehr gelistet, bzw. nur noch solche, die auf .txt enden. Damit
kann man nicht mehr komplett durch den Verzeichnisbaum parsen.
Ich hab das jetzt mit Regular-Expressions auf den FileNamen gelöst und einfach den führenden '*' entfernt,
da eine RegExp. mit dem * nichts anfangen kann bzw. alles ausfiltert. Es darf nur '.txt' sein.
Das mit der RegExp. gefällt mir sogar besser, da das wesentlich mächtiger ist.
Aber ich müsste im Code gleich vordefinierte RegExp für Standardaufgaben irgendwie zur Verfügung stellen,
da nicht jeder weis (einschließlich mir), wie das mit RegExp genau funktioniert.
2. Das Filterproblem! (dürfte erledigt sein! Aber vielleicht fällt ja jemandem noch was gutes dazu ein)
Damit der User die Files nochmals einfach nachfiltern kann. Z.B. nach Datum, Größe ...
hab ich eine Filter-Callback eingeführt, welche der User durch Übergabe des Funktionspointers auf seine
eigene Filterfunktion ausführen kann und so die Files nochmals nach seinen Kriterien nachfiltern.
3. Anpassung auf Linux und Mac und Test
- Ordner Trennzeichen! Wie korrekt ausführen?
4. Verwendung für Multithreading
Ich gehe mal davon aus, dass es Probleme geben wird, wenn man das von mehreren Threads gleichzeitig benutzt!
Lange Rede, kurzer Sinn: hier der bisherige Code
Code: Alles auswählen
;
DeclareModule FS ; FileSystem
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
; ------------------------------------------------------------
; Windows Attributes
; ------------------------------------------------------------
; #PB_FileSystem_Archive ; 32
; #PB_FileSystem_Hidden ; 2
; #PB_FileSystem_Compressed ; 2048
; #PB_FileSystem_Normal ; 128
; #PB_FileSystem_ReadOnly ; 1
; #PB_FileSystem_System ; 4
#FS_Files_All = #PB_FileSystem_Archive|#PB_FileSystem_Hidden|#PB_FileSystem_Compressed|#PB_FileSystem_Normal|#PB_FileSystem_ReadOnly|#PB_FileSystem_System
#FS_Files_Only_Archive = #PB_FileSystem_Archive
#FS_Files_Only_Hidden = #PB_FileSystem_Hidden
#FS_Files_Only_Compressed = #PB_FileSystem_Compressed
#FS_Files_Only_Normal = #PB_FileSystem_Normal
#FS_Files_Only_ReadOnly = #PB_FileSystem_ReadOnly
#FS_Files_Only_System = #PB_FileSystem_System
#FS_Files_Ignore_Archive = #FS_Files_All & ~#PB_FileSystem_Archive
#FS_Files_Ignore_Hidden = #FS_Files_All & ~#PB_FileSystem_Hidden
#FS_Files_Ignore_Compressed= #FS_Files_All & ~#PB_FileSystem_Compressed
#FS_Files_Ignore_Normal = #FS_Files_All & ~#PB_FileSystem_Normal
#FS_Files_Ignore_ReadOnly = #FS_Files_All & ~#PB_FileSystem_ReadOnly
#FS_Files_Ignore_System = #FS_Files_All & ~#PB_FileSystem_System
#FS_Files_Ignore_HiddenAndSystem = #FS_Files_All & ~#PB_FileSystem_Hidden & ~#PB_FileSystem_System
CompilerElse
; ------------------------------------------------------------
; Linux, MAC
; ------------------------------------------------------------
; #PB_FileSystem_Link
; #PB_FileSystem_ReadUser
; #PB_FileSystem_WriteUser
; #PB_FileSystem_ExecUser
; #PB_FileSystem_ReadGroup
; #PB_FileSystem_WriteGroup
; #PB_FileSystem_ExecGroup
; #PB_FileSystem_ReadAll
; #PB_FileSystem_WriteAll
; #PB_FileSystem_ExecAll
#FS_Files_All = #PB_FileSystem_Link|#PB_FileSystem_ReadUser|#PB_FileSystem_WriteUser|#PB_FileSystem_ExecUser|#PB_FileSystem_ReadGroup|#PB_FileSystem_WriteGroup|#PB_FileSystem_ReadAll|#PB_FileSystem_WriteAll|#PB_FileSystem_ExecAll
#PB_Files_Only_Link = #PB_FileSystem_Link
#PB_Files_Only_ReadUser = #PB_FileSystem_ReadUser
#PB_Files_Only_WriteUser = #PB_FileSystem_WriteUser
#PB_Files_Only_ExecUser = #PB_FileSystem_ExecUser
#PB_Files_Only_ReadGroup = #PB_FileSystem_ReadGroup
#PB_Files_Only_WriteGroup = #PB_FileSystem_WriteGroup
#PB_Files_Only_ReadAll = #PB_FileSystem_ReadAll
#PB_Files_Only_WriteAll = #PB_FileSystem_WriteAll
#PB_Files_Only_ExecAll = #PB_FileSystem_ExecAll
#FS_Files_Ignore_Link = #FS_Files_All & ~#PB_FileSystem_Link
#FS_Files_Ignore_ReadUser = #FS_Files_All & ~#PB_FileSystem_ReadUser
#FS_Files_Ignore_WriteUser = #FS_Files_All & ~#PB_FileSystem_WriteUser
#FS_Files_Ignore_ExecUser = #FS_Files_All & ~#PB_FileSystem_ExecUser
#FS_Files_Ignore_ReadGroup = #FS_Files_All & ~#PB_FileSystem_ReadGroup
#FS_Files_Ignore_WriteGroup = #FS_Files_All & ~#PB_FileSystem_WriteGroup
#FS_Files_Ignore_ReadAll = #FS_Files_All & ~#PB_FileSystem_ReadAll
#FS_Files_Ignore_WriteAll = #FS_Files_All & ~#PB_FileSystem_WriteAll
#FS_Files_Ignore_ExecAll = #FS_Files_All & ~#PB_FileSystem_ExecAll
CompilerEndIf
; Structure to list directory entries
Structure TDirectoryEntry
Name.s ; Name of File or Directory
Size.q ; Size of File or Directory
Attributes.i ; Atrributes Hidden, System ...; Linux/Mac ReadUse, WriteUser ...
DateCreated.i
DateAccessed.i
DateModified.i
EntryType.i ; #PB_DirectoryEntry_File, #PB_DirectoryEntry_Directory
EndStructure
Prototype.i FileFilterCallback(*TDirectoryEntry.TDirectoryEntry)
Declare ListFiles(Directory$, List Files.TDirectoryEntry(), SubDirLevel=#PB_Default, RegExpr$="", Flags=#FS_Files_All, *FileFilterCallback=#Null)
Declare.s GetAttributesText(Attrib)
EndDeclareModule
Module FS
EnableExplicit
Procedure.s GetAttributesText(Attrib)
; ===========================================================================
; NAME : GetAttributesText
; DESC : creates a String with all the attributes
; DESC : Windows: "R-H-S-N-A-C"
; DESC : Linux/Mac : "Lnk/Urd/Uwrt/Uexe/Grd/Gwrt/Gexe/Ard/Awrt/Aexe"
; DESC : This is the recursive functions what calls itself
; VAR(Attrib) : The File Attributes (FLAGs)
; RET.s : Attribut Name
; ===========================================================================
Protected ret.s
#SEP = " : "
#Off = "x"
#Off3 ="---"
#Off4 ="----"
; we must select OS-Type because This PB Constants
; for Windows are undifined in Linux and in Linux Windows constans
; are undefined
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
ret ="R-H-S-N-A-C" ; 8x'-' for 8 Flags R,H,S,A,N,C
; ------------------------------------------------------------
; Windows Attributes
; ------------------------------------------------------------
If Not (Attrib & #PB_FileSystem_ReadOnly) : ret = ReplaceString(ret, "R", #Off) : EndIf
If Not (Attrib & #PB_FileSystem_Hidden) : ret = ReplaceString(ret, "H", #Off) : EndIf
If Not (Attrib & #PB_FileSystem_System) : ret = ReplaceString(ret, "S", #Off) : EndIf
If Not (Attrib & #PB_FileSystem_Archive) : ret = ReplaceString(ret, "A", #Off) : EndIf
If Not (Attrib & #PB_FileSystem_Normal) : ret = ReplaceString(ret, "N", #Off) : EndIf
If Not (Attrib & #PB_FileSystem_Compressed) : ret = ReplaceString(ret, "C", #Off) : EndIf
CompilerElse
; ------------------------------------------------------------
; Linux, MAC
; ------------------------------------------------------------
ret ="Lnk/Urd/Uwrt/Uexe/Grd/Gwrt/Gexe/Ard/Awrt/Aexe" ; 8x'-' for 8 Flags R,H,S,A,N,C
If (Attrib & #PB_FileSystem_Link) : ret = ReplaceString(ret, "Lnk", #Off3) : EndIf
; User
If (Attrib & #PB_FileSystem_ReadUser) : ret = ReplaceString(ret, "Urd", #Off3) : EndIf
If (Attrib & #PB_FileSystem_WriteUser) : ret = ReplaceString(ret, "Uwrt", #Off4) : EndIf
If (Attrib & #PB_FileSystem_ExecUser) : ret = ReplaceString(ret, "Uexe", #Off4) : EndIf
CompilerEndIf
ProcedureReturn ret
EndProcedure
Structure TSharedParams ; ListFilesRecursive Shared Parameters
hRegExp.i
ActSubLevel.i
MaxSubLevel.i
Flags.i
FileCount.i ; File Counter
DirCount.i ; Directory Counter
pFileFilterCallback.i ; FilterCallback Preoedure
EndStructure
Define TShareParams.TSharedParams
Procedure _ListFilesRecursive(Directory$, List Files.TDirectoryEntry())
; ===========================================================================
; NAME : _ListFilesRecursive
; DESC : This is the recursive functions what calls itself
; DESC : to path trough the Directory-Tree
; DESC : Attention! Don't call this Function directly
; DESC : it is called by the User-Function ListFiles()
; VAR(Directory$) : actual Directory Name
; VAR(List Files()) : List() to hold the Directory Entries
; VAR(*TShareParams.TSharedParams) Pointer to shard Parameter Type
; VAR(*FileFilterCallback=#Null): Callback-Adress for User FileFilterFunction
; RET : -
; ===========================================================================
Shared TShareParams
Protected hDir, xMatch, Attribute
Protected FileName.s
Protected TDE.TDirectoryEntry
NewList SubDir.s() ; List of SubDirectories
If Right(Directory$, 1) <> "\"
Directory$ + "\"
EndIf
; ClearList(Files()) ; ATTENTION! Do not ClearList because we use Recursive calls what will destroy our List
hDir = ExamineDirectory(#PB_Any, Directory$, "") ; *TShareParams\RegExpr$)
If hDir
;Debug Directory$
TShareParams\DirCount + 1 ; Count the Directory
While NextDirectoryEntry(hDir) ; Steps trough all entries
If DirectoryEntryType(hDir)=#PB_DirectoryEntry_File
Attribute = DirectoryEntryAttributes(hDir) ; Read File Attributes
;Debug GetAttributeText(Attribute)
If (Attribute & TShareParams\Flags) ; List only Selected
With TDE
\Name = Directory$ + DirectoryEntryName(hDir)
\Attributes = Attribute
\Size = DirectoryEntrySize(hDir)
\DateCreated = DirectoryEntryDate(hDir, #PB_Date_Created)
\DateAccessed = DirectoryEntryDate(hDir, #PB_Date_Accessed)
\DateModified = DirectoryEntryDate(hDir, #PB_Date_Modified)
\EntryType = #PB_DirectoryEntry_File
EndWith
With TShareParams
xMatch = #True
; Test the Regular Expression
If \hRegExp
xMatch= MatchRegularExpression(\hRegExp, TDE\Name)
EndIf
; if xMatch is still #True, test the User-Filter
If xMatch And \pFileFilterCallback ; if a Callback is specified, send the datas over the users Filter Funtion
Protected MyFilterProc.FileFilterCallback ; Prototype FileFilterCallback
MyFilterProc = \pFileFilterCallback ; Bind Adress of Users Callback Function
xMatch= MyFilterProc(TDE) ; Call the Users FilterProc, returns #False/#True
EndIf
; if xMatch is still #True, we can add the File to our List()
If xMatch
AddElement(Files()) ; Add new Element to our FileList
Files()=TDE
\FileCount + 1 ; Count Files
EndIf
EndWith
EndIf
Else ; DirectoryEntryType(hDir)= #PB_DirectoryEntry_Directory ; it is a SubDirectory
; List SubDirectories
Select DirectoryEntryName(hDir)
Case ".", ".."
; ignore
Default
AddElement(SubDir())
SubDir() = Directory$ + DirectoryEntryName(hDir)
; Debug SubDir()
EndSelect
EndIf
Wend
FinishDirectory(hDir) ; finish this ExamineDirectory (release the Memory)
; Debug "Sub Level = " + *TShareParams\ActSubLevel + " : Max = " + *TShareParams\MaxSubLevel
With TShareParams
; check if the max depth of Subdirectories reached, at #PB_Default (-1) we search for all
If (\MaxSubLevel = #PB_Default) Or (\ActSubLevel < \MaxSubLevel)
\ActSubLevel + 1 ; now we enter next SubDirctory Level in depth
ForEach SubDir()
_ListFilesRecursive(SubDir(), Files()) ; rekursive call of ListFiles for all Subdirectories
Next
\ActSubLevel - 1 ; when a SubDirctory Level is finished, we go back in depth
EndIf
EndWith
Else
; Debug "Access denied : " + Directory$
EndIf
EndProcedure
Procedure.i ListFiles(Directory$, List Files.TDirectoryEntry(), SubDirLevel=#PB_Default, RegExpr$="", Flags=#FS_Files_All, *FileFilterCallback=#Null)
; ===========================================================================
; NAME : ListFiles
; DESC : This is the main function to list the Files
; DESC : it calls the recursive Function _ListFiles which
; DESC : path trough the Directory-Tree
; DESC :
; VAR(Directory$) : Start Directory
; VAR(List Files()) : List() to hold the Directory Entries
; VAR(SubDirLevel): Scan Subdirectories to this deep
; #PB_Default (-1) = Scan All
; 0 = do not scan subdirecotries
; VAR(RegExpr$) : a Regular expression to filter the File-Names
; VAR(Flags) : Flags to select the FileTypes
; #FS_Files_Only_Hidden : lists only hidden files
; #FS_Files_Ignore_HiddenAndSystem : ignores system an hidden files
; VAR(*FileFilterCallback=#Null): Callback-Adress for User FileFilterFunction
; RET.i : Number of files listed
; ===========================================================================
Shared TShareParams
Debug Directory$
;Shared Shared_Flags, Shared_SubDirLevel, Shared_Pattern$, Shared_ActualSubLevel
; Flags=0 would list nothing, because we set to ListAll
With TShareParams
If Flags=0
\Flags = #FS_Files_All
Else
\Flags = Flags
EndIf
;\RegExpr$ = RegExpr$
\MaxSubLevel = SubDirLevel
\ActSubLevel = 0
\hRegExp = 0
\pFileFilterCallback = *FileFilterCallback
; because Pattern$ like "*.pdf" for ExamineDirectory hide Directories and Files which are not matching the Pattern
; so we can't go deeper into SubDirectories because we don't get it with ExamineDirectory
; 2 solutions:
; a) we do ExamineDirecotry twice : once without Pattern To get Subdirectories And a second time For filtering
; b) we use Regular Expressions instead of Patterns because this is more powerful
; but *.pdf do not match! We have to use .pdf
If RegExpr$
Debug RegExpr$
If Left(RegExpr$,1) = "*"
RegExpr$ = Mid(RegExpr$,2)
EndIf
If RegExpr$ <> #Null$
\hRegExp = CreateRegularExpression(#PB_Any, RegExpr$)
EndIf
EndIf
EndWith
_ListFilesRecursive(Directory$, Files())
ProcedureReturn ListSize(Files())
If TShareParams\hRegExp
FreeRegularExpression(TShareParams\hRegExp)
EndIf
EndProcedure
EndModule
; ***************************************************************************
; T E S T C O D E
; ***************************************************************************
EnableExplicit
UseModule FS
Macro DF(MyDate)
FormatDate("%yyyy/%mm/%dd", MyDate)
EndMacro
Procedure.s CrateFileInfoString(*Entry.TDirectoryEntry)
#SEP = #TAB$
With *Entry
ProcedureReturn \Name + #SEP + Str(\Size) + " : " + GetAttributesText(\Attributes) + #SEP + DF(\DateCreated) + #SEP + DF(\DateModified) + #SEP + DF(\DateModified)
EndWith
EndProcedure
Procedure.i MyFileSizeFilter(*TDir.TDirectoryEntry)
; ===========================================================================
; MyFileSizeFilter
; This is the user idividal FileFilter Function which is a callback function
; the structure of this function is defined by Prototype FileFilterCallback()
; ===========================================================================
With *TDir
If \Size < 2048 ; only files < 2048Bytes
; Debug "MyFilter" + \Size
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndWith
EndProcedure
Define Dir$
Define I, ret
Debug Dir$
NewList MyFiles.TDirectoryEntry()
Dir$ = "D:\Temp"
; open a Path-Requester if Dir$ is not definied
If Dir$=#Null$
Dir$ = PathRequester("Select Path", "C:\")
EndIf
If Dir$=#Null$
End
EndIf
; #PB_Default {-1}
; ret = ListFiles("C:\", MyFiles(), #PB_Default,"", #FS_Files_Only_hidden) ; Lists hidden files on C:\
ret = ListFiles(Dir$, MyFiles(), #PB_Default, ".txt", #FS_Files_All, @MyFileSizeFilter())
Debug "No of Files found : " + ret
Debug ""
I = 1
ForEach MyFiles()
With MyFiles()
Debug Str(I) + " : " + CrateFileInfoString(MyFiles())
EndWith
I + 1
Next