powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Список файлов и папок в указанной директории
14 сообщений из 14, страница 1 из 1
Список файлов и папок в указанной директории
    #39411250
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
мне сделали такой код
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
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. Что править надо?
А то в этом коде я не бум бум. А автор кода не хочет объяснять.
Помогите пожалуйста
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39411337
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Все это было
как получить дерево файлов и папок в заданной дериктории? И все это в двумерный массив засунуть из 3х столбцов, в который если это папка в соседние столбцы дописывать 0 0 0755?

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

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
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


или предложите свой вариант решения задачи
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39411355
Фотография Akina
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BlackeAngelили предложите свой вариант решения задачи
FileSystemObject.Folder - Folders property, Files property.
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39411381
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Akina,
То есть?
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412067
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
BlackeAngel,
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
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(objFSO.GetParentFolderName(strSourceFolder)) + 1
    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


Как прикрутить запись в массив? Заменял Debug.Print на вывод в массив, но не то.
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412068
Фотография Akina
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BlackeAngelКак прикрутить запись в массив?
Зачем массив? пиши в коллекцию, в разы проще. И об индексах не надо заботиться, и итерации проще.
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412087
Roman Mejtes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BlackeAngelBlackeAngel,
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
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(objFSO.GetParentFolderName(strSourceFolder)) + 1
    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


Как прикрутить запись в массив? Заменял Debug.Print на вывод в массив, но не то.
если делать через массивы, то нужно создать массив размером N и писать в него, когда массив закончится, создать другой массив размером N*2, скопировать в него первый и писать дальше.
А можно не делать велосипед, а использовать списки или коллекции, не уверен, но вроде в VB Нет перечислителей.
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412102
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Roman Mejtes,
Создаем массив равный кол-ву файлов в папке +1 и никакого велосипеда. Только как в него писать, вот в чем вопрос. Четверг никак не соображу
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412103
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Roman Mejtes,
Либо же писать в переменную с короткой на конце, а затем делать сплит по каретке. Опять же тут фиг знает как. Либо же создавать массив заведомо больше, а потом пустые строки удалять.
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412104
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Roman Mejtes,
Либо же, опять же писать в коллекцию и из нее выводить в массив.
Либо расскажите мне как работать с коллекцией чтобы можно было работать по 4 столбцам.
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412105
BlackeAngel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
На сколько помню коллекция состоит из:ключ+значение. А у меня тогда будет ключ+значение+значение+значение. Причем тот же самый ключ при сравнении дальше надо брать маленькими буквами. Хотя это вроде решается Lcase()
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412151
Фотография Akina
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BlackeAngelу меня тогда будет ключ+значение+значение+значение
Сериализуй в ключ + (значение+значение+значение).
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39412682
Roman Mejtes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
есть еще 1 очень производительный метод =) вызываете команду:
"DIR <путь> /s /b /a" на выходе получате список который вам нужен.
список можно получить через файл или через stdout, работает на много быстрее, еще и кешируется, то есть 2 раз выполняется в 2 раза быстрее :) потом строки разбить в массив
...
Рейтинг: 0 / 0
Список файлов и папок в указанной директории
    #39419737
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BlackeAngelЛибо же, опять же писать в коллекцию и из нее выводить в массив.
Либо расскажите мне как работать с коллекцией чтобы можно было работать по 4 столбцам.

Будьте проще - работайте с Recordset-ом.

Код: vbnet
1.
2.
3.
4.
5.
6.
Dim rr As New ADODB.Recordset

rr.Fields.Append "Папка", adVarChar, 100, adFldUpdatable
rr.Fields.Append "Файл", adInteger, , adFldUpdatable
... ' ну и так далее
rr.Open



Ну а далее пишите в него свои данные как обычно.

И будут вам поля и фильтры и сортировка...
...
Рейтинг: 0 / 0
14 сообщений из 14, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Список файлов и папок в указанной директории
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]