PureBasic Forums - English

Code: Select all

EnableExplicit

Structure FileSearch
	id.i
	dir.s
	mask.s
	depth.i
	c.i
	Array hDir.i(0)
	Array SearchPath.s(0)
EndStructure


Procedure OpenFileSearchRecursive(*fid.FileSearch, dir.s, mask.s = "", depth = 130)
; 	Protected 
	If Right(dir, 1) <> #PS$
		dir + #PS$
	EndIf
; 	Стартовые значения для поиска
	With *fid
		ReDim \hDir(depth)
		ReDim \SearchPath(depth)
		\dir = dir
		\mask = mask
		\depth = depth
		\c = 0
		
		\SearchPath(\c) = \dir
		\hDir(\c) = ExamineDirectory(#PB_Any, \dir, "")
		If Not \hDir(\c)
			ProcedureReturn 0
		EndIf
	EndWith
EndProcedure

; дескрипторы поиска закрываются самостоятельно по завершению получения элементов,
; но если требуется закрыть принудительно не продолжая поиск, то вызываем это.
Procedure FinishFileSearchRecursive(*fid.FileSearch)
	Protected i
	With *fid
		For i = 0 To \depth ; до указанной глубины
			If \hDir(i) ; если есть дескриптор, то проверяем является ли он действительным
				If IsDirectory(\hDir(i))
					FinishDirectory(\hDir(i))
				Else
					Break ; после первого несуществующего дескриптора идут только закрытые
				EndIf
			Else
				Break ; после первого попавшегося нуля выпрыгиваем, так как глубже будут одни нули.
			EndIf
		Next
	EndWith
EndProcedure

Procedure.s NextFileSearchRecursive(*fid.FileSearch)
	Protected Name.s, res$
	
	With *fid
		Repeat
; 		If \c >= 0
			While NextDirectoryEntry(\hDir(\c))
				Name = DirectoryEntryName(\hDir(\c))
				If Name = "." Or Name = ".."
					Continue
				EndIf
				If DirectoryEntryType(\hDir(\c)) = #PB_DirectoryEntry_Directory
					If \c >= \depth
						Continue
					EndIf
					\dir = \SearchPath(\c)
					\c + 1
					\SearchPath(\c) = \dir + Name + #PS$
					\hDir(\c) = ExamineDirectory(#PB_Any, \SearchPath(\c), "")
					If Not \hDir(\c)
						\c - 1
					EndIf
				Else
					If Not Asc(\mask) Or GetExtensionPart(name) = \mask
						res$ = \SearchPath(\c) + Name
						Break 2
					EndIf
				EndIf
			Wend
			FinishDirectory(\hDir(\c))
			\c - 1
		Until \c < 0
	EndWith
	ProcedureReturn res$
EndProcedure


Define fid.FileSearch
Define tmp$
Define i

; OpenFileSearchRecursive(@fid, "C:\Temp\FileSizesList1\Linux", "ini")
OpenFileSearchRecursive(@fid, GetTemporaryDirectory(), "tmp")
Repeat
	i + 1
	tmp$ = NextFileSearchRecursive(fid)
	Debug tmp$
; 	If i > 20 ; если что-то пошло не так, ограничим 20 элементами. Это для теста.
; 		Break
; 	EndIf
Until Not Asc(tmp$)
Debug i - 1