PureBasic

Code : Tout sélectionner

; On donne le nom du dossier dont on souhaite lister le contenu 
Dossier.s = "C:\Program Files\PureBasic\catalogs\"

Code : Tout sélectionner

Enumeration 
  #Tree_RechercheFichier
EndEnumeration


; Cette liste va recevoir le contenu du dossier dans lequel on a lancé la recherche
Structure InfoFichier
  Nom.s
  Type.l
  Taille.l
EndStructure
NewList RechercheFichier.InfoFichier()
Global DossierRecherche.s

Procedure.l TreeGadget_CustomDraw(WindowID.l, Message.l, wParam.l, lParam.l)
  #NM_CUSTOMDRAW = #NM_FIRST - 12 
  #CDDS_ITEM = $10000 
  #CDDS_SUBITEM = $20000 
  #CDDS_PREPAINT = $1 
  #CDDS_ITEMPREPAINT = #CDDS_ITEM | #CDDS_PREPAINT 
  #CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM | #CDDS_ITEMPREPAINT 
  #CDRF_DODEFAULT = $0 
  #CDRF_NEWFONT = $2 
  #CDRF_NOTIFYITEMDRAW = $20 
  #CDRF_NOTIFYSUBITEMDRAW = $20 
  
  If Message = #WM_NOTIFY
    *TVCDHeader.NMTVCUSTOMDRAW = lParam
    If *TVCDHeader\nmcd\hdr\hWndFrom = GadgetID(#Tree_RechercheFichier) And *TVCDHeader\nmcd\hdr\code = #NM_CUSTOMDRAW
      Select *TVCDHeader\nmcd\dwDrawStage
          
        Case #CDDS_PREPAINT
          ProcedureReturn #CDRF_NOTIFYITEMDRAW
          
        Case #CDDS_ITEMPREPAINT
          ; Modifier la couleur de fond
          ; *TVCDHeader\clrTextBk = RGB(255, 255, 223)
          
          ; Modifier la couleur du texte
          ; *TVCDHeader\clrText = RGB(0, 0, 255)
          
          ; Modifier la police
          ; Font est le handle d'une police que vous avez précédemment chargée.
          ; SelectObject_(*LVCDHeader\nmcd\hDC, Font)
          
          ; Le niveau de l'item (dans combien de node il se trouve)
          ; *TVCDHeader\iLevel
          
          ; Le numéro de la ligne affichée
          ; Num.l = TreeGadgetItemNumber(#Tree_RechercheFichier, *TVCDHeader\nmcd\dwItemSpec)
          
          ; On regarde si l'icône est affichée
          pitem.TV_ITEM\mask = #TVIF_IMAGE
          pitem\hItem = *TVCDHeader\nmcd\dwItemSpec
          SendMessage_(GadgetID(#Tree_RechercheFichier), #TVM_GETITEM, 0, pitem)
          If pitem\iImage = 0 ; Si pas d'icône
            Num.l = TreeGadgetItemNumber(#Tree_RechercheFichier, *TVCDHeader\nmcd\dwItemSpec) ; On récupère le numéro de la ligne
            If Num >= 0
              SelectElement(RechercheFichier(), Num)
              Fichier.s = DossierRecherche + RechercheFichier()\Nom ; Le nom du fichier auquel on souhaite récupérer l'icône
              SHGetFileInfo_(Fichier, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON) ; On récupère l'icône
              pitem.TV_ITEM\mask = #TVIF_IMAGE | #TVIF_SELECTEDIMAGE
              pitem\iImage = InfosFile\iIcon
              pitem\iSelectedImage = InfosFile\iIcon
              SendMessage_(GadgetID(#Tree_RechercheFichier), #TVM_SETITEM, 0, pitem) ; On affiche l'icône
            EndIf
          EndIf
          
          ProcedureReturn #CDRF_NEWFONT
          
        Default
          ProcedureReturn #PB_ProcessPureBasicEvents
          
      EndSelect
    Else
      ProcedureReturn #PB_ProcessPureBasicEvents
    EndIf
  Else
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndIf
EndProcedure

Procedure AddTreeGadgetImageList(Gadget)
  himl = SendMessage_(GadgetID(Gadget), #TVM_GETIMAGELIST, #TVSIL_NORMAL, 0)
  If himl = 0 ; Pas d'imagelist associé au TreeGadget
    himl = SHGetFileInfo_("", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
    SendMessage_(GadgetID(Gadget), #TVM_SETIMAGELIST, #TVSIL_NORMAL, himl) ; On associe l'imagelist avec le gadget
    SetWindowCallback(@TreeGadget_CustomDraw()) ; Cette callback sert à personnaliser l'apparence du TreeGadget
  EndIf
EndProcedure

Procedure AnalyseDossier(Num, Dossier.s)
  If Right(Dossier, 1) <> "\" : Dossier + "\" : EndIf
  
  ; Le dossier 2
  Dossier2.s = RemoveString(Dossier, DossierRecherche)
  Dossier3.s = ReplaceString(Left(Dossier2, Len(Dossier2) - 1), "\", "\?1?")
  ; on met ?1? devant le nom des dossier et ?2? devant le nom des fichiers
  ; Ainsi lors du tri des données, les dossiers seront placés avant les fichiers
  ; Il suffira ensuite de supprimer les ?1? et ?2? des noms de fichiers ou dossiers
  ; Le caratère ? n'étant pas utilisable dans les noms de fichiers, cet ajout ne présente aucun problème
  If Dossier3
    Dossier3 = "?1?" + Dossier3 + "\"
  EndIf
  
  If ExamineDirectory(Num, Dossier, "*.*")
    Repeat
      FileType = NextDirectoryEntry()
      
      If FileType = 1
        ; On a un fichier
        Name.s = DirectoryEntryName()
        AddElement(RechercheFichier())
        RechercheFichier()\Nom = Dossier3 + "?2?" + Name
        RechercheFichier()\Type = 1
        RechercheFichier()\Taille = DirectoryEntrySize()
        
      ElseIf FileType = 2
        ; On a un dossier
        Name.s = DirectoryEntryName()
        If Name <> "." And Name <> ".."
          AddElement(RechercheFichier())
          RechercheFichier()\Nom = Dossier3 + "?1?" + Name
          RechercheFichier()\Type = 2
          RechercheFichier()\Taille = -2
          
          ; On lance l'analyse sur ce nouveau dossier (analyse récursive)
          AnalyseDossier(Num + 1, Dossier + Name)
          ; On réactive le dossier de recherche en cours
          UseDirectory(Num)
          
        EndIf
      EndIf
      
    Until FileType = 0
  EndIf
EndProcedure

Procedure RechercheFichiers(Dossier.s)
  
  If Right(Dossier, 1) <> "\" : Dossier + "\" : EndIf ; On s'assure qu'il y a bien un \ à la fin du nom du dossier

  AddTreeGadgetImageList(#Tree_RechercheFichier)
  ClearGadgetItemList(#Tree_RechercheFichier)
  ClearList(RechercheFichier())
  
  DossierRecherche = Dossier
  
  AnalyseDossier(0, Dossier)
    
  ; On tri les noms de fichiers et dossiers
  ; Je passe ici par un SortStructuredList car SortList à une erreur dans PB 3.93 avec le tri de listes chainés contenant du texte, ceci doit-être résolu pour les future version.
  SortStructuredList(RechercheFichier(), 2, 0, #PB_Sort_String)
  
  ; On retire les ?1? et ?2?, et également l'adresse du dossier d'origine
  ForEach RechercheFichier()
    RechercheFichier()\Nom = RemoveString(RemoveString(RechercheFichier()\Nom, "?1?"), "?2?")
  Next

  ; On rempli la liste de fichier
  HideGadget(#Tree_RechercheFichier, 1) ; Le fait de cacher le gadget permet de le remplir plus rapidement
  Nb_Dossier = 0
  n = 0
  ForEach RechercheFichier()
    Temp = CountString(RechercheFichier()\Nom, "\")
    If Temp < Nb_Dossier
      Nb_Dossier - 1
      CloseTreeGadgetNode(#Tree_RechercheFichier)
      AddGadgetItem(#Tree_RechercheFichier, n, GetFilePart(RechercheFichier()\Nom))
    ElseIf Temp > Nb_Dossier
      Nb_Dossier + 1
      OpenTreeGadgetNode(#Tree_RechercheFichier)
      AddGadgetItem(#Tree_RechercheFichier, n, GetFilePart(RechercheFichier()\Nom))
      SetGadgetItemState(#Tree_RechercheFichier, n - 1, #PB_Tree_Expanded)
    Else
      AddGadgetItem(#Tree_RechercheFichier, n, GetFilePart(RechercheFichier()\Nom))
    EndIf
    n + 1
  Next
  
  ; Les icônes ne sont pas affichées ici, elles sont gérer par la callback
  ; Pourquoi ?
  ; Les icônes sont très long à charger, donc plutot que de récupérer les icônes de tous les éléments
  ; La callback récupère les icônes uniquement pour les éléments affichés
  ; Ce qui donne un gain de temps considérable
  
  SetGadgetState(#Tree_RechercheFichier, 0) ; On sélectionne le premier élément
  
  HideGadget(#Tree_RechercheFichier, 0)
  
EndProcedure








; Ouvre une fenêtre
If OpenWindow(0, 0, 0, 500, 250, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered, "Recherche fichiers") = 0 Or CreateGadgetList(WindowID()) = 0
  End
EndIf

TreeGadget(#Tree_RechercheFichier, 0, 0, 500, 200, #PB_Tree_AlwaysShowSelection)

Temps1 = ElapsedMilliseconds()

; On lance la recherche
; Vous devez mettre ici le dossier de votre choix
; 3700 fichiers en 16 secondes sur mon 900mhz
RechercheFichiers("c:\Program files\PureBasic\")

Temps2 = ElapsedMilliseconds()

TextGadget(#PB_Any, 0, 200, 200, 15, Str(CountList(RechercheFichier())) + " fichiers et dossiers")
TextGadget(#PB_Any, 0, 215, 200, 15, Str(Temps2 - Temps1) + " ms")

Repeat
  Event = WaitWindowEvent()
  
Until Event = #PB_Event_CloseWindow