| |
Данный пример позволяет "перебрать" все
подпапки одной определенной директории. К
примеру, вам необходимо в каждой подпапке
подсчитать количество файлов, или выполнить
стандартную процедуру над каждым файлом, да мало
ли какое применение. Данный код я использую в
своей программе 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
|
|