VBCoding Библиотека кодов Visual Basic 6 Файловая система Рекурсивный перебор все подпапок в указанной папке

Visual Basic 6
Рекурсивный перебор все подпапок в указанной папке
Данный пример позволяет "перебрать" все подпапки одной определенной директории. К примеру, вам необходимо в каждой подпапке подсчитать количество файлов, или выполнить стандартную процедуру над каждым файлом, да мало ли какое применение. Данный код я использую в своей программе FPkiller. Разместите на форме элементы FileListBox, DirListBox, DriveListBox а также элемент CommandButton.

Затем вставьте следующий код, и ваша программа заработает. Все необходимые, на мой взгляд, пояснения даны в примере. Как вы понимаете, в данном примере основной процедурой является процедура ScanFolders(). Ваш код для обработки каждой папки должен помещаться между /// и \\\.

 

Dim InitialFolder
Dim OldDrive As String
Dim TotalDir 'переменная для обозначение общего количества папок

Private Sub Command1_Click()
ChDrive Drive1.Drive
ChDir Dir1.Path
InitialFolder = CurDir
ScanFolders
End Sub

Sub ScanFolders()
Dim SubFolders As Integer
'///начало обращения к внешней процедуре
'в данный блок вы можете вставить любую процедуру обработки текущей папки
'MsgBox CurrentFolder(Dir1.Path) 'просмотр текущей папки
'снимите маркер, если хотите получить общее количество папок, включая начальную
'TotalDir = TotalDir + 1

'\\\конец обращения к внешней процедуре
SubFolders = Dir1.ListCount
If SubFolders > 0 Then
For i = 0 To SubFolders - 1
ChDir Dir1.List(i)
Dir1.Path = Dir1.List(i)
File1.Path = Dir1.List(i)
Form1.Refresh
ScanFolders
Next
End If
File1.Path = Dir1.Path
MoveUp
End Sub

Sub MoveUp()
If Dir1.List(-1) <> InitialFolder Then
ChDir Dir1.List(-2)
Dir1.Path = Dir1.List(-2)
End If
End Sub
Private Sub Dir1_Change()
ChDir Dir1.Path
File1.Path = Dir1.Path
End Sub
Private Sub Dir1_Click()
With Dir1
.Path = .List(.ListIndex)
End With
End Sub
Private Sub Drive1_Change()
On Error GoTo ErrHan
ChDrive Dir1.Path
Dir1.Path = Drive1.Drive
Dir1.Refresh
'присвоение этой переменной значение Drive1.Drive для исключения ошибки
OldDrive = Drive1.Drive
Exit Sub
ErrHan:
Drive1.Drive = OldDrive
End Sub
Private Sub Form_Load()
ChDrive App.Path
ChDir App.Path
End Sub
Private Function CurrentFolder(sFolderPath)
Dim str1() As String
str1 = Split(sFolderPath, "\")
CurrentFolder = str1(UBound(str1))
End Function

 

Источник: http://www.vbnet.ru/ 
 

Добавить комментарий


Защитный код
Обновить

 
VBCoding Библиотека кодов Visual Basic 6 Файловая система Рекурсивный перебор все подпапок в указанной папке  
Powered by Exponenta -