Каталог с подкаталогами

rinsk

Well-Known Member
Lotus team
12.11.2009
895
84
Казань
#1
Гуру программирования - оптимизируйте плиз!:rolleyes:
без рекурсии получение всех поддиректорий и файлов
Код:
Function GetSubFile (hom As Variant)
Dim h,d,s As String
Dim p() As Variant
Redim Preserve p(0)	 
Dim k As Variant
k=0
If Right(hom,1)<>"\" Then hom=hom+"\"
h=hom+";"
On Error Goto errdir
Do While Instr(1,h,";")>0
d=Left(h,Instr(1,h,";")-1)
h=Mid(h,Instr(1,h,";")+1)
s=Dir(d+"*.*",16)
Do While s<>""
If s<>"." And s<>".." And 16=Getfileattr ( d+s ) Then 
h=d+s+"\;"+h
Else
If s<>"." And s<>".." And 16<>Getfileattr ( d+s ) And 8<>Getfileattr ( d+s ) Then 
Redim Preserve p(k)
p(k)=d+s
k=k+1
End If
End If
s=Dir() 
Loop
Loop
GetSubFile=p
Exit Function	 
errdir:
GetSubFile=""
Exit Function 
End Function
 

nvyush

Well-Known Member
Lotus team
22.04.2009
2 317
0
48
Подмосковье
#2
в таком виде читать влом
Аналогично.
Не стоит использовать однобуквенные названия переменных за исключением разве что параметров циклов. Потом сами замучаетесь разбирать собственный код.
 

VladSh

начинающий
Lotus team
11.12.2009
1 248
2
Киев (Русь)
#4
rinsk
Пожалуй, так получше будет:
Код:
Function GetSubFiles(sFSource As String)
   On Error Goto ErrH
   Const SEP_SLASH = "\"
   Const SEP_CLOSE = ";"
   Const ATTR_FOLDER = 16
   Dim sFTemp As String, sF As String, sEntry As String, sFile As String
   Dim arrF() As String
   
   sFTemp = sFSource
   If Right(sFTemp, 1) <> SEP_SLASH Then sFTemp = sFTemp + SEP_SLASH
   sFTemp = sFTemp + SEP_CLOSE
   
   Do
	  pos% = Instr(1, sFTemp, SEP_CLOSE)
	  If pos% <= 0 Then Exit Do
	  
	  sF = Left(sFTemp, pos% - 1)
	  sFTemp = Mid(sFTemp, pos% + 1)
	  sEntry = Dir(sF + "*.*", ATTR_FOLDER)
	  
	  Do While Len(sEntry) <> 0
		 sFile = sF + sEntry
		 
		 Select Case sEntry
		 Case ".", "..":
		 Case Else
			Select Case GetFileAttr(sFile)
			Case ATTR_FOLDER:
			   sFTemp = sFile + SEP_SLASH + SEP_CLOSE + sFTemp
			Case Is <> 8:
			   Redim Preserve arrF(file%)
			   arrF(file%) = sFile
			   file% = file% + 1
			End Select
		 End Select
		 
		 sEntry = Dir()
	  Loop
   Loop
   
   GetSubFiles = arrF
   Exit Function
   
ErrH:
   Print GetThreadInfo(10) & " -> " & GetThreadInfo(1) & ": " & Error$ & " (" & Err & "), in line " & Erl
   Exit Function
End Function
Возвращаемые значения:
- массив полных имён файлов;
- если папки пусты - пустой массив (0-й элемент = "");
- если ошибка - Empty (для перестраховки можно вначале проверять результат на IsEmpty).
:)
 

nvyush

Well-Known Member
Lotus team
22.04.2009
2 317
0
48
Подмосковье
#6
Код:
ErrH:
Print Lsi_info(12) + " -> " + Lsi_info(2) + ": " + Error$ + " (" & Err & "), in line " & Erl
Exit Function
End Function
КМК, лучше так, чтобы Err не сбрасывалось:
Код:
ErrH:
Print Lsi_info(12) + " -> " + Lsi_info(2) + ": " + Error$ + " (" & Err & "), in line " & Erl
Resume quit
quit:
End Function
 

VladSh

начинающий
Lotus team
11.12.2009
1 248
2
Киев (Русь)
#7
rinsk
И ещё стал работать гораздо быстрее:)

nvy
У меня сбрасывается в обоих вариантах. Но это не так важно, т.к. можно возвращаемый результат проверить на IsEmpty.
Если же кто-то использует свои обработчики с выходом вверх по стэку вызовов, то вместо строки с принтом просто вставить вызов своей процы.
 

lmike

нет, пердело совершенство
Lotus team
27.08.2008
6 438
351
homepage.mac.com
#8
это типа получать список файлов в каталоге?
а не проще в шел команду сунуть? :)
в вянде dir /s b /o
в никсах - подходящий вариант ls или find (зависит от цели получения списка)
 

VladSh

начинающий
Lotus team
11.12.2009
1 248
2
Киев (Русь)
#11
да ещё гибче будет: и сортировать и фильтры и нужные атрибуты...
ну, может быть (если с подкаталогами в один вызов отработает)... я просто не люблю что-то внешнее лишний раз дёргать
если гибкость нужна, тогда да.. - это наверное будет лучше, чем класс писать.

Сейчас попробовал - действительно работает, но надо будет что-то писать для парсинга того, что вылетело на консоль, а это неинтересно..