Listage des fichiers récursif

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Listage des fichiers récursif

Message par Chris »

J'ai été obligé de refaire une procédure récursive pour lister les fichiers, celle que j'avais pour la version 3.94 ne fonctionnait pas avec la v4.0

Alors, si quelqu'un en a besoin, et que ça peut éviter de la refaire, je la poste!

Code : Tout sélectionner

Procedure ListeFichiers(NumDir.l, NameDir.s, Ext.s)
  File.s : NameDir = Trim(NameDir)
  
  ; Vérification de la chaine
  If Right(NameDir,1) = "." : NameDir = Left(NameDir, Len(NameDir)-1) : EndIf
  If Right(NameDir,1)<> "\" : NameDir+"\":EndIf
  
  ; Vérification de l'extension
  If Right(Ext, 1) = "*" Or Ext = ""
    NoExt = #True
  Else
    If FindString(Ext, ".", 1)
      Ext = GetExtensionPart(Ext) : NoExt = #False
    Else
      Ext = Ext : NoExt = #False
    EndIf
  EndIf
  
  If ExamineDirectory(NumDir, NameDir, "*.*")
    While NextDirectoryEntry(NumDir)
      File = DirectoryEntryName(NumDir)
      
      Select DirectoryEntryType(NumDir)
        Case #PB_DirectoryEntry_File
          Select NoExt
            Case #True
              ; *** Pas d'extension sélectionnée
              Debug NameDir + File
              ; ***
              
            Case #False
              ;*** Avec extension sélectionnée
              If GetExtensionPart(File) = Ext
                Debug NameDir + File
              EndIf
              ; ***
              
          EndSelect
          
        Case #PB_DirectoryEntry_Directory
          If DirectoryEntryName(NumDir) <> "." And DirectoryEntryName(NumDir) <> ".."
            ; *** Affichage des dossiers
            
            ; ***
            ListeFichiers(NumDir + 1, NameDir + File, Ext)
          EndIf
          
      EndSelect
    Wend
    
    FinishDirectory(NumDir)
  EndIf
EndProcedure

; ************************* Test
Chem$ = "D:\PureBasic3\MesProgs\"
ListeFichiers(0, Chem$, "*.pb")
Voilà ce que ça donne avec un TreeGadget()

Code : Tout sélectionner

#ImgFile = 1
#ImgFold = 2

Global Tree_0

;{- Images du TreeGadget
If CreateImage(#ImgFile, 16, 16)
  StartDrawing(ImageOutput(#ImgFile))
  Box(0, 0, 16, 16, $FFFFFF)
  DrawText(3,0,"F", $0000FF)
  StopDrawing()
EndIf

If CreateImage(#ImgFold, 16, 16)
  StartDrawing(ImageOutput(#ImgFold))
  Box(0, 0, 16, 16, $FFFFFF)
  DrawText(3,0,"D", $FF0000)
  StopDrawing()
EndIf
;}-

;-Procédures
Procedure ListeFichiers(NumDir.l, NameDir.s, Ext.s)
  File.s : NameDir = Trim(NameDir)
  
  ; Vérification de la chaine
  If Right(NameDir,1) = "." : NameDir = Left(NameDir, Len(NameDir)-1) : EndIf
  If Right(NameDir,1)<> "\" : NameDir+"\":EndIf
  
  ; Vérification de l'extension
  If Right(Ext, 1) = "*" Or Ext = ""
    NoExt = #True
  Else
    If FindString(Ext, ".", 1)
      Ext = GetExtensionPart(Ext) : NoExt = #False
    Else
      Ext = Ext : NoExt = #False
    EndIf
  EndIf
  
  If ExamineDirectory(NumDir, NameDir, "*.*")
    While NextDirectoryEntry(NumDir)
      File = DirectoryEntryName(NumDir)
      
      Select DirectoryEntryType(NumDir)
        Case #PB_DirectoryEntry_File
          
          Select NoExt
            Case #True
              ; ********** Avec extension *********
              AddGadgetItem(Tree_0, -1, File, ImageID(#ImgFile), NumDir)
              ; ***********************************
              
            Case #False
              ;*********** Sans Extension *********
              If GetExtensionPart(File) = Ext
                AddGadgetItem(Tree_0, -1, File, ImageID(#ImgFile), NumDir)
                
              EndIf
              ; ***********************************
          EndSelect
          
        Case #PB_DirectoryEntry_Directory
          If DirectoryEntryName(NumDir) <> "." And DirectoryEntryName(NumDir) <> ".."
            ; ***********************************
            AddGadgetItem(Tree_0, -1, DirectoryEntryName(NumDir), ImageID(#ImgFold), NumDir)
            ; ***********************************
            
            ListeFichiers(NumDir +1, NameDir + File, Ext)
          EndIf
          
      EndSelect
    Wend
    
    FinishDirectory(NumDir)
  EndIf
EndProcedure

 
If OpenWindow(0, 5, 5, 400, 543, "Tree",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
  If CreateGadgetList(WindowID(0))
    Tree_0 = TreeGadget(#PB_Any, 5, 5, 390, 535)
  EndIf
EndIf

Chem$ = "D:\PureBasic3\MesProgs\"
ListeFichiers(0, Chem$, "*.pb")

Repeat
  Event  = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
End