Новости
Видео
Microsoft
Windows 10
Железо
Программы
Форум

Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » Разное - [решено] Список файлов и папок в заданной директории

1 2 Следующая >
Ответить
Настройки темы
Разное - [решено] Список файлов и папок в заданной директории

Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

Изменения
Автор: blackeangel
Дата: 28-02-2017
мне сделали такой код
Код: Выделить весь код
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
Ну или предложите свой вариант решения задачи

Отправлено: 23:32, 27-02-2017

 

Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать

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

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

Отправлено: 09:43, 28-02-2017 | #2



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

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

Цитата Iska:
«Поубивав бы»™.

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

Отправлено: 10:29, 28-02-2017 | #3


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать

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

Отправлено: 11:07, 28-02-2017 | #4


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

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

Отправлено: 12:15, 28-02-2017 | #5


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать

Цитата 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).
Это сообщение посчитали полезным следующие участники:

Отправлено: 12:30, 28-02-2017 | #6


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

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

Отправлено: 13:12, 28-02-2017 | #7


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать

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

Отправлено: 13:47, 28-02-2017 | #8


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

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

Отправлено: 15:17, 28-02-2017 | #9


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

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

Отправлено: 18:37, 28-02-2017 | #10

1 2 Следующая >


Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » Разное - [решено] Список файлов и папок в заданной директории

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
CMD/BAT - [решено] Проверка директории на наличии файлов и папок chernecrishi Скриптовые языки администрирования Windows 6 15-05-2015 15:42
CMD/BAT - выводить в текстовый файл список файлов и папок из директории где запущен APTEM267 Скриптовые языки администрирования Windows 2 07-02-2014 06:32
Прочие - Как вывести список папок и файлов в текстовый файл? Vowan Программное обеспечение Windows 15 23-11-2013 15:29
PHP - получить список файлов директории по фильтру xNiSSaNx Вебмастеру 1 18-06-2013 06:34
CMD/BAT - [решено] список файлов в директории neprotiv Скриптовые языки администрирования Windows 7 13-01-2012 07:44


« Предыдущая тема | Следующая тема »


 
Переход