Рекурсивный поиск файлов и текста внутри них на VB6: класс FileSearch

Что умеет класс FileSearch

Встроенный поиск Windows не всегда под рукой и не всегда удобен: нужно найти все конфигурационные файлы, где упомянут старый сервер, или все логи с определённым кодом ошибки, а потом обработать результат программно. Для таких задач полезен небольшой класс, который принимает стартовую папку, маску имён и искомый текст, а возвращает коллекцию найденных путей.

У класса два публичных члена. Функция SearchFolders запускает поиск и возвращает Collection с результатами. Свойство SearchResults отдаёт ту же коллекцию повторно, если её нужно прочитать позже. Вся рекурсия спрятана в закрытой процедуре ListFolders.

Маска имени и искомый текст задаются в синтаксисе регулярных выражений, поэтому несколько вариантов перечисляются через вертикальную черту.

Dim fs As New FileSearch
Dim item As Variant

' все txt, ini и log, где встречается один из двух серверов
For Each item In fs.SearchFolders("D:\Projects", "\.(txt|ini|log)$", _
                                   "srv-old|10\.0\.0\.15", vbTextCompare)
    Debug.Print item
Next

Рекурсивный обход через FileSystemObject

Объект Folder из Microsoft Scripting Runtime содержит две коллекции: Files с файлами текущей папки и SubFolders с вложенными папками. Рекурсия строится естественно: обработали файлы, затем для каждой подпапки вызвали ту же процедуру. Глубина вложенности на практике не превышает нескольких десятков уровней, так что стек VB6 выдерживает её без проблем.

Результаты копятся в переменной уровня модуля m_colResults. Её пересоздают в начале SearchFolders, иначе повторный поиск тем же экземпляром класса смешает старые и новые находки.

Private m_colResults As Collection
Private m_rxName As New VBScript_RegExp_55.RegExp
Private m_rxText As New VBScript_RegExp_55.RegExp

Public Function SearchFolders(ByVal strFolder As String, _
        Optional ByVal strNames As String, Optional ByVal strText As String, _
        Optional ByVal Compare As VbCompareMethod = vbTextCompare) As Collection
    Set m_colResults = New Collection
    m_rxName.Pattern = strNames: m_rxName.IgnoreCase = True
    m_rxText.Pattern = strText: m_rxText.IgnoreCase = (Compare = vbTextCompare)
    ListFolders New Scripting.FileSystemObject, strFolder, strNames, strText
    Set SearchFolders = m_colResults
End Function

Private Sub ListFolders(fso As Scripting.FileSystemObject, ByVal strFolder As String, _
        ByVal strNames As String, ByVal strText As String)
    Dim fld As Scripting.Folder, sub_ As Scripting.Folder, fil As Scripting.File
    On Error Resume Next          ' папки без доступа просто пропускаем
    Set fld = fso.GetFolder(strFolder)
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    For Each fil In fld.Files
        If Len(strNames) = 0 Or m_rxName.Test(fil.Name) Then
            If Len(strText) = 0 Then
                m_colResults.Add fil.Path
            ElseIf FileContains(fil.Path) Then
                m_colResults.Add fil.Path
            End If
        End If
        DoEvents
    Next
    For Each sub_ In fld.SubFolders
        ListFolders fso, sub_.Path, strNames, strText
    Next
End Sub

Проверка содержимого файла

Для поиска текста файл читается целиком в строку и проверяется одним вызовом RegExp.Test. Это быстрее построчного чтения, потому что регулярное выражение один раз проходит по всему тексту. Шаблоны обоих выражений компилируются в начале поиска и используются для каждого файла, а не создаются заново.

Чтение через Open For Binary и Input$ с длиной файла даёт содержимое за одну операцию. Перед этим стоит отсечь слишком большие файлы: гигабайтный дамп, прочитанный в строку VB6, займёт вдвое больше памяти (строки хранятся в UTF-16) и надолго подвесит программу.

Private Function FileContains(ByVal strPath As String) As Boolean
    Const MAX_SIZE As Long = 20& * 1024 * 1024   ' 20 МБ
    Dim f As Integer, buf As String
    On Error GoTo Fail
    If FileLen(strPath) = 0 Or FileLen(strPath) > MAX_SIZE Then Exit Function
    f = FreeFile
    Open strPath For Binary Access Read Shared As #f
    buf = Input$(LOF(f), #f)
    Close #f
    FileContains = m_rxText.Test(buf)
    Exit Function
Fail:
    If f > 0 Then Close #f   ' файл занят или нет доступа
End Function

DoEvents и отмена долгого поиска

Поиск по диску с десятками тысяч файлов занимает минуты. Без DoEvents форма перестаёт перерисовываться, а Windows помечает окно как «не отвечает». Вызов DoEvents в цикле по файлам отдаёт управление очереди сообщений, и интерфейс остаётся живым.

У DoEvents есть обратная сторона: пользователь может снова нажать кнопку «Найти» и запустить второй поиск поверх первого. Блокируйте кнопку на время работы и добавьте в класс публичное свойство Cancel. Процедура ListFolders проверяет его в каждой итерации и выходит, если флаг поднят. Кнопка «Стоп» на форме просто устанавливает fs.Cancel = True.

Для индикации прогресса удобно объявить в классе событие FileChecked(ByVal Path As String) и вызывать RaiseEvent перед проверкой каждого файла. Форма, объявившая объект WithEvents, покажет текущий путь в строке состояния.

Подводные камни на реальных дисках

Большинство этих проблем не ломает поиск, а лишь тихо исключает часть файлов. Поэтому полезно вести счётчик пропущенных папок и показывать его пользователю вместе с результатом, чтобы «ничего не найдено» не вводило в заблуждение.

• системные папки вроде System Volume Information и чужие профили пользователей выдают ошибку 70 при обращении, поэтому GetFolder обёрнут в On Error Resume Next;
• точки соединения (junction) в Windows Vista и новее, например «Documents and Settings», могут вести в уже обойденные каталоги, и без проверки атрибута ReparsePoint поиск пройдёт одни и те же файлы дважды;
• бинарные файлы (exe, dll, zip) с подходящей маской проверяются впустую, ограничивайте маску расширений;
• текст в UTF-8 и UTF-16 не совпадёт с шаблоном на кириллице при чтении в ANSI, для таких файлов нужен ADODB.Stream;
• пути длиннее 260 символов FileSystemObject не открывает.

Производительность

Основное время уходит на дисковые операции, а не на регулярные выражения. Несколько приёмов заметно ускоряют работу: отсекать файлы по имени до чтения содержимого, не читать файлы нулевой длины, передавать один экземпляр FileSystemObject по всей рекурсии вместо создания нового на каждом уровне.

Вызывать DoEvents на каждом файле тоже накладно. Если файлов сотни тысяч, достаточно отдавать управление раз в 50 или 100 итераций, используя счётчик и оператор Mod.

Как это делают сегодня

Вопросы и ответы