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

[rinsk]

Гуру программирования - оптимизируйте плиз!
без рекурсии получение всех поддиректорий и файлов

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]

в таком виде читать влом

Аналогично.
Не стоит использовать однобуквенные названия переменных за исключением разве что параметров циклов. Потом сами замучаетесь разбирать собственный код.

 

[Omh]

И некая страсть к переменным типа Variant проеживается.

 

[VladSh]

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).

 

[rinsk]

rinsk
Пожалуй, так получше будет:

Спасибо всем критикам - ровно 12 лет прожил сей код в неизменном виде! И благодаря VladSh обновился, приобрел некоторую академичность и законченность

 

[nvyush]

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]

rinsk
И ещё стал работать гораздо быстрее

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

 

[lmike]

это типа получать список файлов в каталоге?
а не проще в шел команду сунуть?
в вянде dir /s b /o
в никсах - подходящий вариант ls или find (зависит от цели получения списка)

 

[VladSh]

это типа получать список файлов в каталоге?

И в подкаталогах тоже.

 

[lmike]

И в подкаталогах тоже.

это я понял - отсюда и команды
да ещё гибче будет: и сортировать и фильтры и нужные атрибуты...

 

[VladSh]

да ещё гибче будет: и сортировать и фильтры и нужные атрибуты...

ну, может быть (если с подкаталогами в один вызов отработает)... я просто не люблю что-то внешнее лишний раз дёргать
если гибкость нужна, тогда да.. - это наверное будет лучше, чем класс писать.

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

 

[lmike]

продолжение вариантов вынес в "более подходящее" место LS2J