Листинг 3. Перемещение по дереву файловой системы

Public DirCounter% ‘ текущее число просмотренных каталогов

Public Sub HowManyFilesInThisDirectory(PathName$, FileName$,  _
    FileCounter%)
‘
‘  подсчет числа найденных файлов по заданному шаблону:
‘  PathName$ - каталог
‘  FileName$ - шаблон имени файла
‘  FileCounter% - текущее значение счетчика найденных файлов
‘==================================================
    Dim MyFile$, MyDirCount%
    Dim NewPathName$, i%
   
    DirCounter% = DirCounter% + 1 ‘ смотрим очередной каталог
    ‘
    ‘ подсчет файлов в данном каталоге:
    MyFile$ = Dir(PathName$ + FileName$) ‘ первый поиск
    Do While MyFile$ <> “”
        FileCounter% = FileCounter% + 1
        ‘ тут можно выполнить какую-нибудь операцию с файлом
        MyFile$ = Dir  ‘ следующий поиск
    Loop
    ‘
    ‘ определяем состав подкаталогов в данном каталоге
    ReDim arrPath$(100)  ‘ для списка подкаталогов
    Call CurrentDirCounter(PathName$, “”, MyDirCount%, _
       arrPath$(), vbDirectory)
    ‘
    If MyDirCount% > 0 Then ‘есть подкаталоги
        For i% = 1 To MyDirCount%
            ‘ !! рекурсивное обращение к САМОЙ СЕБЕ!!
            NewPathName$ = PathName$ + arrPath$(i) + “\”
            Call HowManyFilesInThisDirectory(NewPathName$, _
                 FileName$, FileCounter%)
        Next
    End If
End Sub

Public Sub CurrentDirCounter(PathName$, FileName$, MyDirCount%,
arrPath$(), attr%)
‘
‘  Формирование списка имен элементов (attr% задает тип)
‘  в текущем каталоге
‘
    Dim MyDir$
   
    MyDirCount% = 0 ‘счетчик подкаталогов в текущем каталоге
    MyDir$ = Dir(PathName$ + FileName$, attr%) ‘первый поиск
                                              ‘ подкаталогов
    Do While MyDir$ <> “”
        If MyDir$ <> “.” And MyDir$ <> “..” Then
            If GetAttr(PathName$ + MyDir$) = attr% Then
              ‘ найден каталог
                MyDirCount% = MyDirCount% + 1
                If MyDirCount% > UBound(arrPath$) Then
                    ‘ увеличивает размер массива
                    ‘ с сохранением старой информации
                    ReDim Preserve arrPath$(UBound(arrPath$) + 100)
                End If
                arrPath$(MyDirCount%) = MyDir$
            End If
        End If
    MyDir$ = Dir  ‘ следующий поиск
    Loop
End Sub