[решено] Список файлов и папок в заданной директории

[blackeangel]

мне сделали такой код

Function DirList(Pth As String) As String()
Dim R() As String
Dim D() As String
Dim T() As String

sz& = 100
ReDim D(1 To sz&) As String

cD$ = Dir$(Pth + "\*.*", vbDirectory)
ptrD& = 0

Do

If cD$ = "" Then Exit Do

If cD$ <> "." And cD$ <> ".." Then

If GetAttr(Pth + "\" + cD$) And vbDirectory Then

ptrD& = ptrD& + 1

If ptrD& > sz& Then
sz& = sz& + 100
ReDim Preserve D(1 To sz&) As String
End If

D(ptrD&) = Pth + "\" + cD$

End If

End If

cD$ = Dir$()

Loop

sz& = 100
ReDim R(1 To 3, 1 To sz&) As String

cF$ = Dir$(Pth + "\*.*", vbNormal)
ptrF& = 0

Do

If cF$ = "" Then Exit Do

ptrF& = ptrF& + 1

If ptrF& > sz& Then
sz& = sz& + 100
ReDim Preserve R(1 To 3, 1 To sz&) As String
End If

R(1, ptrF&) = Pth + "\" + cF$
R(2, ptrF&) = Hex$(GetAttr(Pth + "\" + cF$))
R(3, ptrF&) = CStr(FileLen(Pth + "\" + cF$))

cF$ = Dir$()

Loop

For i& = 1 To ptrD&

cP$ = D(i&)
T = DirList(cP$)

For j& = 1 To UBound(T, 2)

ptrF& = ptrF& + 1

If ptrF& > sz& Then
sz& = sz& + 100
ReDim Preserve R(1 To 3, 1 To sz&) As String
End If

R(1, ptrF&) = T(1, j&)
R(2, ptrF&) = T(2, j&)
R(3, ptrF&) = T(3, j&)

Next j&

Erase T

Next i&

If ptrF& > 0 Then

ReDim Preserve R(1 To 3, 1 To ptrF&) As String

Else

ReDim R(1 To 3, 0 To 0) As String

End If

DirList = R

End Function

Sub Test()

Dim D() As String

D = DirList("C:\Program Files")

For i& = 1 To UBound(D, 2)
Debug.Print D(1, i&); " "; D(2, i&); " "; D(3, i&)
Next i&
End Sub

Но мне не надо чтобы в столбцах записывались атрибуты. Надо чтобы напротив папок в соседних столбцах записывалось лишь 0 0 0755. Что править надо?
А то в этом коде я не бум бум. А автор кода не хочет объяснять.
Помогите пожалуйста.
Все это было
как получить дерево файлов и папок в заданной дериктории? И все это в двумерный массив засунуть из 3х столбцов, в который если это папка в соседние столбцы дописывать 0 0 0755?

К такому вот виду, например:


system/app/AdupsFota 0 0 0755
system/app/AdupsFota/AdupsFota.apk
system/app/AdupsFota/arm 0 0 0755
system/app/AdupsFota/arm/AdupsFota.odex
system/app/AdupsFotaReboot 0 0 0755
system/app/AdupsFotaReboot/AdupsFotaReboot.apk
system/app/AdupsFotaReboot/arm 0 0 0755
system/app/AdupsFotaReboot/arm/AdupsFotaReboot.odex
system/app/ApplicationsProvider 0 0 0755
system/app/ApplicationsProvider/ApplicationsProvider.apk
system/app/ApplicationsProvider/arm 0 0 0755
system/app/ApplicationsProvider/arm/ApplicationsProvider.odex
system/app/AtciService 0 0 0755
system/app/AtciService/AtciService.apk
system/app/AtciService/arm 0 0 0755
system/app/AtciService/arm/AtciService.odex
system/app/AutoDialer 0 0 0755
system/app/AutoDialer/AutoDialer.apk
system/app/AutoDialer/arm 0 0 0755
system/app/AutoDialer/arm/AutoDialer.odex
system/app/BSPTelephonyDevTool 0 0 0755
system/app/BSPTelephonyDevTool/BSPTelephonyDevTool.apk
system/app/BSPTelephonyDevTool/arm 0 0 0755
system/app/BSPTelephonyDevTool/arm/BSPTelephonyDevTool.odex
system/app/BasicDreams 0 0 0755
system/app/BasicDreams/BasicDreams.apk
system/app/BasicDreams/arm 0 0 0755
system/app/BasicDreams/arm/BasicDreams.odex
system/app/BatteryWarning 0 0 0755
system/app/BatteryWarning/BatteryWarning.apk
system/app/BatteryWarning/arm 0 0 0755
system/app/BatteryWarning/arm/BatteryWarning.odex
system/app/Bluetooth 0 0 0755
system/app/Bluetooth/Bluetooth.apk
system/app/Bluetooth/arm 0 0 0755
system/app/Bluetooth/arm/Bluetooth.odex
system/app/Bluetooth/lib 0 0 755
system/app/Bluetooth/lib/arm 0 0 755
system/app/Bluetooth/lib/arm/libbluetooth_jni.so
system/app/Browser 0 0 755
system/app/Browser/Browser.apk
system/app/Browser/arm 0 0 0755
system/app/Browser/arm/Browser.odex
system/app/Calculator 0 0 0755
system/app/Calculator/Calculator.apk
system/app/Calculator/arm 0 0 0755
system/app/Calculator/arm/Calculator.odex

Ну или предложите свой вариант решения задачи

[Iska]

«Поубивав бы»™.

Надо чтобы напротив папок в соседних столбцах записывалось лишь 0 0 0755. Что править надо? »
Замените:
Debug.Print D(1, i&); " "; D(2, i&); " "; D(3, i&)
на:
Debug.Print D(1, i&) & " 0 0 0755"

[blackeangel]

«Поубивав бы»™.

Надо чтобы напротив папок в соседних столбцах записывалось лишь 0 0 0755. Что править надо? »
Замените:
Debug.Print D(1, i&); " "; D(2, i&); " "; D(3, i&)
на:
Debug.Print D(1, i&) & " 0 0 0755"
Нее, так он на все это повесит и на файлы и на папки. А мне надо было только на папки.

[Iska]

Простите, а где Вы там видите папки? Я — не вижу. Только файлы с полными путями.

[blackeangel]

Простите, а где Вы там видите папки? Я — не вижу. Только файлы с полными путями.
Действительно. Блин, подстава.
Тогда переходим к пункту - свой вариант ;)

[Iska]

Тогда переходим к пункту - свой вариант »
Как я понимаю, Вас интересует примерно такое:
Option Explicit

Sub Sample()
Dim strSourceFolder As String
Dim objFSO As New Scripting.FileSystemObject


strSourceFolder = "C:\test"

If objFSO.FolderExists(strSourceFolder) Then
ScanSubFolders objFSO.GetFolder(strSourceFolder), Len(strSourceFolder) + 2
Else
Debug.Print "Can't find source folder [" & strSourceFolder & "]."
End If
End Sub

Sub ScanSubFolders(objFolder As Scripting.Folder, intTruncateTo As Integer)
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder

Debug.Print Replace(Mid(objFolder.Path, intTruncateTo), "\", "/") & " 0 0 0755"

For Each objFile In objFolder.Files
Debug.Print Replace(Mid(objFile.Path, intTruncateTo), "\", "/")
Next objFile

For Each objSubFolder In objFolder.SubFolders
ScanSubFolders objSubFolder, intTruncateTo
Next objSubFolder
End Sub

В проекте должна быть установлена ссылка на библиотеку Microsoft Scripting Runtime (%SystemRoot%\System32\scrrun.dll).

[blackeangel]

Iska, почти, надо еще имя папки в пути, которая сканируется.
В вашем примере будет выглядеть примерно так
test\папка1
test\папка2\файл1

[Iska]

надо еще имя папки в пути, которая сканируется. »
Попробуйте заменить строку процедуры вызова ScanSubFolders на:
ScanSubFolders objFSO.GetFolder(strSourceFolder), Len(objFSO.GetParentFolderName(strSourceFolder)) + 1

[blackeangel]

Iska, отлично! То что нужно. Спасибо.

[blackeangel]

Iska, потыкался, так и не смог это всё хозяйство в массив засунуть. Дайте подсказку?

[Iska]

blackeangel, «шо, опять?»™ ;). Дались Вам эти массивы.

Что Вы планируете с ним дальше делать?

[blackeangel]

blackeangel, «шо, опять?»™ ;). Дались Вам эти массивы.

Что Вы планируете с ним дальше делать?
Не опять, а снова ;) Ну а что поделать?
Дальше, мы его будем делать двухмерным, по тем самым регуляркам, что тогда так долго пытали. Далее заполнять оставшиеся не заполненные 3 столбца напротив файлов, читая данные из файла и/или же из правил по вхождению имени файла. Формировать отчет в новом конечном файле, используя данные из массива.
Как то так.

[blackeangel]

Iska,
Ну раз вы так настраиваете на словаре, то дайте сводную таблицу двумерный массив|коллекция|словарь в которой отображены все плюсы и минусы, на русском языке. И где по-человечески дано определение ключа. Я вот этого не понимаю.
Хотя, давайте посмотрим как это будет выглядеть в словаре или коллекции ;)

[Iska]

blackeangel, дык, я не настаиваю именно на словаре. Я просто пишу, что массивы в данном случае явно не лучший выбор. Почему — потому что вижу многомерные массивы вкупе со множественными ReDim и ReDim Preserve. Я бы ещё понял, если бы Вы пользовали одномерный массив из структур (Type Statement (https://msdn.microsoft.com/en-us/library/aa266315(v=vs.60).aspx)). Словарь — это, собственно, тот же массив, только ассоциативный. Вместо многомерного массива используется тот факт, что его элементами могут быть не только простые типы данных, но и другие, «вложенные», словари.

Дальше, мы его будем делать двухмерным, по тем самым регуляркам, что тогда так долго пытали. »
Почему не сразу делать двумерным?

Далее заполнять оставшиеся не заполненные 3 столбца напротив файлов, читая данные из файла и/или же из правил по вхождению имени файла. »
Почему не сразу заполнять?

В общем, вот такой Вам примерчик, с использованием простого и незатейливого средства — набора записей (RecordSet):
Option Explicit

Sub Sample()
Dim strSourceFolder As String
Dim objFSO As New Scripting.FileSystemObject
Dim objRecordset As New ADODB.Recordset
Dim arrFoldersAndFiles As Variant

Dim i As Integer, j As Integer


strSourceFolder = "C:\test"

If objFSO.FolderExists(strSourceFolder) Then
With objRecordset
With .Fields
.Append "RelativePath", ADODB.adVarChar, 255
.Append "Attributes1", ADODB.adVarChar, 10
.Append "Attributes2", ADODB.adVarChar, 10
.Append "Attributes3", ADODB.adVarChar, 10
End With

.Open
.Sort = "RelativePath ASC"

ScanSubFolders objFSO.GetFolder(strSourceFolder), Len(objFSO.GetParentFolderName(strSourceFolder)) + 1, objRecordset

'.MoveFirst
'
'Do Until .EOF
' With .Fields
' Debug.Print .Item("RelativePath").Value, .Item("Attributes1").Value, .Item("Attributes2").Value, .Item("Attributes3").Value
' End With
'
' .MoveNext
'Loop

.MoveFirst
arrFoldersAndFiles = .GetRows()
.Close

For i = LBound(arrFoldersAndFiles, 1) To UBound(arrFoldersAndFiles, 1)
For j = LBound(arrFoldersAndFiles, 2) To UBound(arrFoldersAndFiles, 2)
Debug.Print "arrFoldersAndFiles("; i; ";"; j; ")="; arrFoldersAndFiles(i, j)
Next j
Next i
End With
Else
Debug.Print "Can't find source folder [" & strSourceFolder & "]."
End If
End Sub

Sub ScanSubFolders(objFolder As Scripting.Folder, intTruncateTo As Integer, objRecordset As ADODB.Recordset)
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder

'Debug.Print Replace(Mid(objFolder.Path, intTruncateTo), "\", "/") & " 0 0 0755"
objRecordset.AddNew Array("RelativePath", "Attributes1", "Attributes2", "Attributes3"), Array(Replace(Mid(objFolder.Path, intTruncateTo), "\", "/"), "0", "0", "0755")

For Each objFile In objFolder.Files
'Debug.Print Replace(Mid(objFile.Path, intTruncateTo), "\", "/")
objRecordset.AddNew Array("RelativePath"), Array(Replace(Mid(objFile.Path, intTruncateTo), "\", "/"))
Next objFile

For Each objSubFolder In objFolder.SubFolders
ScanSubFolders objSubFolder, intTruncateTo, objRecordset
Next objSubFolder
End Sub

Конечным итогом будет, как Вы и просили, двумерный массив arrFoldersAndFiles. В свойствах проекта необходимо добавить ссылку на Microsoft ActiveX Data Objects Library (их может быть несколько, выбирайте не ниже 2.8, выше — можно).


Использование словарей/ассоциативных массивов или наборов записей (RecordSet) уместно там, где нам заранее неизвестен конечный размер данных, потому как в этих случаях мы можем легко и произвольно его наращивать (в отличие от обычного массива, который требует предварительного указания точного размера).

И где по-человечески дано определение ключа. Я вот этого не понимаю. »
Человеческим языком это рассказано здесь: Dictionary (http://www.script-coding.com/WSH/Dictionary.html).

Главный недостаток класса Scripting.Dictionary — в нём в принципе нет возможности обратиться к элементу коллекции по порядковому номеру. Позже, когда Microsoft делала .Net, в нём это было исправлено, и класс .Net System.Collections.ArrayList (ArrayList Class (System.Collections) (https://msdn.microsoft.com/en-us/library/system.collections.arraylist(v=vs.110).aspx)) получил такую возможность. Кстати, данный класс может также использоваться не только как класс .Net, но и ограниченно — как объект Automation (может потребоваться принудительная регистрация его библиотеки), со всеми его приятственными плюшками. Например: VBScript Scripting Techniques: ArrayLists (http://www.robvanderwoude.com/vbstech_data_arraylist.php).

[blackeangel]

Почему — потому что вижу многомерные массивы вкупе со множественными ReDim и ReDim Preserve.

Например можно:
1)посчитать кол-во файлов и папок и получить конкретный размер массива.
2)Можно писать в переменную, а потом сплитить и получить тот же массив.
Или эти варианты имеют подводные камни?

[Iska]

1. В данном случае — можно посчитать. Минус — придётся делать двойной проход по дереву (второй проход, конечно, должен быть быстрее, поскольку всё дерево или хотя бы его часть будет в кэше). Но есть варианты, когда заранее тупо неизвестно количество, и нет возможности второго прохода/разбора.

2. Можно, но ещё накладнее. Работа со строками в VBScript/VBA/VB очень медленная (с точки зрения машинного времени, разумеется).

[blackeangel]

1. В данном случае — можно посчитать. Минус — придётся делать двойной проход по дереву (второй проход, конечно, должен быть быстрее, поскольку всё дерево или хотя бы его часть будет в кэше). Но есть варианты, когда заранее тупо неизвестно количество, и нет возможности второго прохода/разбора.

2. Можно, но ещё накладнее. Работа со строками в VBScript/VBA/VB очень медленная (с точки зрения машинного времени, разумеется).
Ну вот время для пользователя становится критичным, когда он ждет результата. А если там 1с то он и не заметит. Дольше будет происходить "вывод на экран".
Для решения своей задачи, могу ограничить массив 20к и удалять пустые строки из массива.
Давайте разберём оба варианта? Ибо эти решения можно будет занести в ГДЗ.

[Iska]

и удалять пустые строки из массива. »
ReDim Preserve — как бы не ещё медленнее был :).

Давайте разберём оба варианта? »
Дело в том, что мне ни тот, ни другой вариант не нравятся. А какое-то более серьёзное погружение потребует от Вас детального описания всей задачи и дерева выбранного Вами алгоритма решения.