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

[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]

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




Цитата blackeangel:



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

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

Замените:



Код:

Код: Выделить всё

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

на:



Код:

Код: Выделить всё

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

[Iska]

Цитата Iska:



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




Цитата blackeangel:



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

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

Замените:



Код:

Код: Выделить всё

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

на:



Код:

Код: Выделить всё

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

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

[blackeangel]

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

[Iska]

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

[Iska]

Цитата 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]

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

В вашем примере будет выглядеть примерно так

test\папка1

test\папка2\файл1

[blackeangel]

Цитата blackeangel:



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

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

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



Код:

Код: Выделить всё

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

[blackeangel]

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

[blackeangel]

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