PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Recursive directory search

https://www.purebasic.fr/english/viewtopic.php?t=24887

Page 1 of 2

Recursive directory search

Posted: Mon Dec 04, 2006 10:59 pm
by Clutch
Code updated for 5.20+

Code: Select all

Procedure SearchDirectory(dir$, pattern$, List dList.s(), level.l = 0)
  Protected eName$
  NewList Dirs.s()
  
  If (level = 0)
    ClearList(dList())
  EndIf
  
  If Right(dir$, 1) <> "\"
    dir$ + "\"
  EndIf
  
  If ExamineDirectory(0, dir$, "")
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
        eName$ = DirectoryEntryName(0)
        If (eName$ <> ".") And (eName$ <> "..")
          AddElement(Dirs())
          Dirs() = eName$ + "\"
        EndIf
      EndIf
    Wend
    FinishDirectory(0)
    
    If ExamineDirectory(0, dir$, pattern$)
      While NextDirectoryEntry(0)
        eName$ = DirectoryEntryName(0)
        If (eName$ <> ".") And (eName$ <> "..")
          AddElement(dList())
          dList() = dir$ + eName$
          If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
            dList() + "\"
          EndIf
        EndIf
      Wend
      FinishDirectory(0)
    EndIf
  EndIf
  
  If ListSize(Dirs())
    ForEach Dirs()
      SearchDirectory(dir$ + Dirs(), pattern$, dList(), level + 1)
    Next
  EndIf
  
  If (level = 0)
    ForEach dList()
      dList() = Mid(dList(), Len(dir$) + 1, Len(dList()))
    Next
    SortList(dList(), 2)
  EndIf
  
EndProcedure

NewList FilesAndFolders.s()

SearchDirectory("C:\WINDOWS", "sys*", FilesAndFolders())

Debug "Found " + Str(ListSize(FilesAndFolders())) + " object(s)"
ForEach FilesAndFolders()
  Debug FilesAndFolders()
Next

End

Re: Recursive directory search

Posted: Fri Dec 08, 2006 4:58 pm
by NoahPhense
Very nice!

- np

Posted: Fri Dec 08, 2006 6:49 pm
by AND51
Clutch has got 53 lines. I've got just 34.
  • My procedure...
  • does not use a protected linked list (saves memory)
  • does not examine the directory twice - only if recursive is enabled
  • supports optional recursivity
  • returns number of found items (Clutch, why don't you use ProcedureReturn?)
  • is faster than Clutch's one
  • does not need Clutch's level-parameter
  • has got optional pattern$ parameter (empty pattern lists all items)

Code: Select all

Procedure.l SearchDirectory(dir$, yourLinkedList.s(), pattern$="", recursive=1)
	Static level.l=-1
	If Not Right(dir$, 1) = "\"
		dir$+"\"
	EndIf
	Protected dir.l=ExamineDirectory(#PB_Any, dir$, pattern$)
	If dir
		While NextDirectoryEntry(dir)
			If DirectoryEntryName(dir) <> "." And DirectoryEntryName(dir) <> ".."
				AddElement(yourLinkedList())
				For n=CountString(dir$, "\")-level To CountString(dir$, "\")
					yourLinkedList()+StringField(dir$, n, "\")+"\"
				Next
				yourLinkedList()+DirectoryEntryName(dir)
				If DirectoryEntryType(dir) = #PB_DirectoryEntry_Directory
					yourLinkedList()+"\"
				EndIf
			EndIf
		Wend
		FinishDirectory(dir)
	EndIf
	Protected all.l=ExamineDirectory(#PB_Any, dir$, "")
	If all
		While NextDirectoryEntry(all)
			If DirectoryEntryType(all) = #PB_DirectoryEntry_Directory And DirectoryEntryName(all) <> "." And DirectoryEntryName(all) <> ".."
				level+1
				SearchDirectory(dir$+DirectoryEntryName(all)+"\", yourLinkedList(), pattern$, recursive)
				level-1
			EndIf
		Wend
		FinishDirectory(all)
	EndIf
	ProcedureReturn CountList(yourLinkedList())
EndProcedure ; 34 lines by AND51


NewList FilesAndFolders.s()
found = SearchDirectory("C:\WINDOWS", FilesAndFolders(), "sys*", 1)
ForEach FilesAndFolders()
	Debug FilesAndFolders()
Next
Debug found

Posted: Fri Dec 08, 2006 8:13 pm
by Clutch
AND51 wrote:Clutch has got 53 lines. I've got just 34.
  • My procedure...
  • does not use a protected linked list (saves memory)
  • does not examine the directory twice - only if recursive is enabled
  • supports optional recursivity
  • returns number of found items (Clutch, why don't you use ProcedureReturn?)
  • is faster than Clutch's one
  • does not need Clutch's level-parameter
  • has got optional pattern$ parameter (empty pattern lists all items)
:roll:

I may be missing something here, but I'm not quite sure how you determined it to be faster than what I posted. Try successive calls to both as follows:

On yours:

Code: Select all

NewList FilesAndFolders.s()

num.q = GetTickCount_()

For i = 1 To 10
  found = SearchDirectory("C:\WINDOWS", FilesAndFolders(), "sys*", 1)
  ForEach FilesAndFolders()
     Debug FilesAndFolders()
  Next
  Debug found
  ClearList(FilesAndFolders()) ;Must add this, as it's left up to the caller
Next i

Debug GetTickCount_() - num
On mine:

Code: Select all

NewList FilesAndFolders.s()

num.q = GetTickCount_()

For i = 1 To 10
  SearchDirectory("C:\WINDOWS", "sys*", FilesAndFolders())
  
  Debug "Found " + Str(CountList(FilesAndFolders())) + " object(s)"
  ForEach FilesAndFolders()
    Debug FilesAndFolders()
  Next
Next i

Debug GetTickCount_() - num

End
Yours averaged 53 seconds, mine 2.5 here. Even with only a single call (commenting out the For i/Next i), my code ran consistently 3 times faster. Although, I'm not really sure any of this really matters.

Also, your optional recursivity is broken, by the way. Seems it doesn't matter what is passed for the 'recursive' parameter.

You're right about the ProcedureReturn, though. Good job.

Posted: Fri Dec 08, 2006 9:06 pm
by AND51
I will look at my code again. I've made tweo versions, but publsihed one only due to pattern$-problems...

Posted: Fri Dec 08, 2006 10:01 pm
by Dr. Dri
you cannot make a perf test with the debugger

Dri

Posted: Fri Dec 08, 2006 10:27 pm
by Clutch
Dr. Dri wrote:you cannot make a perf test with the debugger

Dri
:oops: Yikes, that's right! I'm getting the same speed from either procedure without using the debugger.

Posted: Fri Dec 08, 2006 11:27 pm
by AND51
I'm too lazy to re-code my procedure. I think I will do that later. If ExamineDirectory() wouldn't have this bug as I postet in an other sub-forum, I could present you my shorter version...

Posted: Sat Dec 09, 2006 4:57 am
by NoahPhense
heh..

Thanks Clutch, not concerned about saving memory.

The only thing that would make me switch is something that was full API.

- np

Posted: Sat Dec 09, 2006 8:59 pm
by Clutch
You're welcome, NoahPhense. Glad you like it. :)

Posted: Wed Dec 13, 2006 8:15 pm
by dagcrack
Bugs? - Use WINAPI directly then.

Posted: Sat Dec 16, 2006 10:32 am
by Jacobus
hello,
You can to be quick to list in ListIconGadget() for example.
Hide the gadget for the work and show again after.

With the first code of Clutch...

Code: Select all

Procedure SearchDirectory(dir$, pattern$, list.s(), level.l = 0) 
  Protected eName$ 
  NewList Dirs.s() 
  
  If (level = 0) 
    ClearList(list()) 
  EndIf 
  
  If Right(dir$, 1) <> "\" 
    dir$ + "\" 
  EndIf 
  
  If ExamineDirectory(0, dir$, "") 
    While NextDirectoryEntry(0) 
      If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory 
        eName$ = DirectoryEntryName(0) 
        If (eName$ <> ".") And (eName$ <> "..") 
          AddElement(Dirs()) 
          Dirs() = eName$ + "\" 
        EndIf 
      EndIf 
    Wend 
    FinishDirectory(0) 
    
    If ExamineDirectory(0, dir$, pattern$) 
      While NextDirectoryEntry(0) 
        eName$ = DirectoryEntryName(0) 
        If (eName$ <> ".") And (eName$ <> "..") 
          AddElement(list()) 
          list() = dir$ + eName$ 
          If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory 
            list() + "\" 
          EndIf 
        EndIf 
      Wend 
      FinishDirectory(0) 
    EndIf 
  EndIf 

  If CountList(Dirs()) 
    ForEach Dirs() 
      SearchDirectory(dir$ + Dirs(), pattern$, list(), level + 1) 
    Next 
  EndIf 
  
  If (level = 0) 
    ForEach list() 
      list() = Mid(list(), Len(dir$) + 1, Len(list())) 
    Next 
    SortList(list(), 2) 
  EndIf 
  
EndProcedure 

; NewList FilesAndFolders.s() 
; 
; SearchDirectory("C:\WINDOWS", "sys*", FilesAndFolders()) 
; 
; Debug "Found " + Str(CountList(FilesAndFolders())) + " object(s)" 
; ForEach FilesAndFolders() 
;   Debug FilesAndFolders() 
; Next 
; 
; End
;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
;To do quickly in GUI
Enumeration
#win
#Listicon
#BtnStart
#BtnClose
EndEnumeration
Global NewList FilesAndFolders.s()
If OpenWindow(#win,0,0,500,350, "Files and folders", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_TitleBar)<>0 And CreateGadgetList(WindowID(#win))<>0
  
  ListIconGadget(#Listicon, 5,10,490,300, "Results", 1000 , #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_MultiSelect)
  
  ButtonGadget(#BtnStart,5 ,320 ,100 ,20,"Starting")
  ButtonGadget(#BtnClose,125 ,320 ,100 ,20,"Close")
  
  Repeat
  Event = WaitWindowEvent() 
    If Event = #PB_Event_Gadget
       Select EventGadget() 
             
         Case #BtnStart
           StartTime = ElapsedMilliseconds()
            SearchDirectory("C:\", "*.*", FilesAndFolders(),1)
             HideGadget(#Listicon,1); hide Listicongadget to be quick. Comment this line to see the difference 
              ForEach FilesAndFolders()
                AddGadgetItem( #Listicon,-1,FilesAndFolders()) 
              Next
              PastTime = ElapsedMilliseconds()-StartTime
             SetGadgetItemText(#Listicon,-1,"Found " + Str(CountList(FilesAndFolders())) + " object(s)  - Time : "+Str(PastTime/1000)+" seconds",0)
            HideGadget(#Listicon,0); after work, show again. Comment this line to see the difference               
       
         Case #BtnClose
          ClearList(FilesAndFolders()); Necessary, I wouldn't be so sure...
           ClearGadgetItemList(#Listicon)     
            Event = #PB_Event_CloseWindow
           
           
       EndSelect  
    EndIf 
  Until Event = #PB_Event_CloseWindow
 End 
EndIf
Same with AND51 code.
Thanks to you for that.

Posted: Sat Dec 16, 2006 3:39 pm
by netmaestro
I don't like the HideGadget approach, it's faster but it doesn't look good with the ListIcon gadget disappearing briefly while it gets filled and then reappearing. I'd recommend another solution:

Code: Select all

SendMessage_(GadgetID(#Listicon),#WM_SETREDRAW, #False, 0)
  ; fifty million AddGadgetItems...
SendMessage_(GadgetID(#Listicon),#WM_SETREDRAW, #True, 0)
Which is just as effective but looks much better.

Posted: Sat Dec 16, 2006 4:50 pm
by Jacobus
Which is just as effective but looks much better.
Yes, That way it's just as well and you can to add a message : " wait a moment please". (I don't know all apis)

Posted: Wed Dec 20, 2006 12:23 pm
by Shardik
netmaestro wrote: I don't like the HideGadget approach, it's faster but it doesn't look good with the ListIcon gadget disappearing briefly while it gets filled and then reappearing.
What do you think about the (in my opinion :wink: ) most user friendly approach of hiding the gadget but displaying a search animation and setting the cursor to an hour glass?

Add the following two procedures to the top of the code example of Jacobus:

Code: Select all

Procedure StartAnimation(AnimationLib.S, AnimationID.L, WindowID.L, xPos.L, yPos.L)
  #AnimationIDSearchComputer = 152

  AnimationAreaHandle.L
  AnimationLibHandle.L
  WaitCursorHandle.L

  If AnimationAreaHandle = 0
    AnimationAreaHandle = CreateWindowEx_(0, "SysAnimate32", "", #ACS_AUTOPLAY | #ACS_CENTER | #ACS_TRANSPARENT | #WS_CHILD | #WS_VISIBLE | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS, xPos, yPos, 280, 50, WindowID(WindowID), 0, GetModuleHandle_(0), 0)
    AnimationLibHandle = LoadLibrary_(AnimationLib) 
    SendMessage_(AnimationAreaHandle, #ACM_OPEN, AnimationLibHandle, AnimationID)
    While WindowEvent() : Wend
  EndIf

  WaitCursorHandle = LoadCursor_(0, #IDC_WAIT)
  SetCursor_(WaitCursorHandle)
EndProcedure

Procedure StopAnimation()
  Shared AnimationAreaHandle.L
  Shared AnimationLibHandle.L
  Shared WaitCursorHandle.L

  If AnimationAreaHandle <> 0
    DestroyWindow_(AnimationAreaHandle)
    AnimationAreaHandle = 0
    FreeLibrary_(AnimationLibHandle)
  EndIf

  If WaitCursorHandle <> 0
    SetCursor_(LoadCursor_(0, #IDC_ARROW))
    WaitCursorHandle = 0
  EndIf
EndProcedure
and change the #BtnStart code block to

Code: Select all

         Case #BtnStart 
           StartTime = ElapsedMilliseconds() 
           HideGadget(#Listicon,1); hide Listicongadget to be quick. Comment this line to see the difference 
           StartAnimation("Shell32.DLL", #AnimationIDSearchComputer, #win, 110, 130)
           SearchDirectory("C:", "*.*", FilesAndFolders(),1) 
           ForEach FilesAndFolders() 
             AddGadgetItem( #Listicon,-1,FilesAndFolders()) 
           Next
           StopAnimation()
           PastTime = ElapsedMilliseconds()-StartTime 
           SetGadgetItemText(#Listicon,-1,"Found " + Str(CountList(FilesAndFolders())) + " object(s)  - Time : "+Str(PastTime/1000)+" seconds",0) 
           HideGadget(#Listicon,0); after work, show again. Comment this line to see the difference
and see the difference... :P
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited