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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

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

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

Код:

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

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

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

Цитата:

Цитата blackeangel

Надо чтобы напротив папок в соседних столбцах записывалось лишь 0 0 0755. Что править надо? »

Замените:

Код:

Debug.Print D(1, i&); " "; D(2, i&); " "; D(3, i&)

на:

Код:

Debug.Print D(1, i&) & " 0 0 0755"

Цитата:

Цитата Iska (Сообщение 2715278)

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

Цитата:

Цитата blackeangel

Надо чтобы напротив папок в соседних столбцах записывалось лишь 0 0 0755. Что править надо? »

Замените:

Код:

Debug.Print D(1, i&); " "; D(2, i&); " "; D(3, i&)

на:

Код:

Debug.Print D(1, i&) & " 0 0 0755"

Нее, так он на все это повесит и на файлы и на папки. А мне надо было только на папки.

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

Цитата:

Цитата Iska (Сообщение 2715317)

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

Действительно. Блин, подстава.
Тогда переходим к пункту - свой вариант ;)

Цитата:

Цитата blackeangel

Тогда переходим к пункту - свой вариант »

Как я понимаю, Вас интересует примерно такое:

Код:

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

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

Цитата:

Цитата blackeangel

надо еще имя папки в пути, которая сканируется. »

Попробуйте заменить строку процедуры вызова ScanSubFolders на:

Код:

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

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

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

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

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

Цитата:

Цитата Iska (Сообщение 2715481)

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

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

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

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

blackeangel, дык, я не настаиваю именно на словаре. Я просто пишу, что массивы в данном случае явно не лучший выбор. Почему — потому что вижу многомерные массивы вкупе со множественными ReDim и ReDim Preserve. Я бы ещё понял, если бы Вы пользовали одномерный массив из структур (Type Statement). Словарь — это, собственно, тот же массив, только ассоциативный. Вместо многомерного массива используется тот факт, что его элементами могут быть не только простые типы данных, но и другие, «вложенные», словари.

Цитата:

Цитата blackeangel

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

Почему не сразу делать двумерным?

Цитата:

Цитата blackeangel

Далее заполнять оставшиеся не заполненные 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) уместно там, где нам заранее неизвестен конечный размер данных, потому как в этих случаях мы можем легко и произвольно его наращивать (в отличие от обычного массива, который требует предварительного указания точного размера).

Цитата:

Цитата blackeangel

И где по-человечески дано определение ключа. Я вот этого не понимаю. »

Человеческим языком это рассказано здесь: Dictionary.

Главный недостаток класса Scripting.Dictionary — в нём в принципе нет возможности обратиться к элементу коллекции по порядковому номеру. Позже, когда Microsoft делала .Net, в нём это было исправлено, и класс .Net System.Collections.ArrayList (ArrayList Class (System.Collections)) получил такую возможность. Кстати, данный класс может также использоваться не только как класс .Net, но и ограниченно — как объект Automation (может потребоваться принудительная регистрация его библиотеки), со всеми его приятственными плюшками. Например: VBScript Scripting Techniques: ArrayLists.

Цитата:

Цитата Iska

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

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

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

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

Цитата:

Цитата Iska (Сообщение 2715612)

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

Цитата:

Цитата blackeangel

и удалять пустые строки из массива. »

ReDim Preserve — как бы не ещё медленнее был :).

Цитата:

Цитата blackeangel

Давайте разберём оба варианта? »

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