Парсер HTML

[alibek]

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

В данный момент кирпич имеет форму модуля с тремя публичными процедурами, вывод осуществляется массивом пользовательского типа.
В дальнейшем это будет класс, с объектами, событиями и методами.

Тип TagType -- в нем хранится имя тэга, количество его параметров и его атрибуты (в массивах Fields и Values), для атрибутов без параметров (типа атрибута nowrap тэга table) в поле Value указан vbNullChar.

Тип TagTypes -- в нем хранится массив ("коллекция") тэгов.
Принцип хранения следующий.
Индекс элемента -- порядковый номер тэга. Элементы хранятся в том порядке, в котором они записаны в HTML-файле. У элемента есть свойство Last, это номер элемента, на котором действие тэга заканчивается. Для обычных тэгов эти два числа всегда равны. Для тэгов-контейнеров значение Last равно индексу последнего тэга, входящего в тэг-контейнер.
Эти два свойства позволяют выстроить иерархическую структуру тэгов. Принцип построения такой структуры довольно прост:
1) Если Last = Index, значит тэг не имеет вложенных элементов;
2) Если Last > Index, значит тэг является узлом дерева и все элементы с индексами Index+1...Last являются его потомками. Повторяя п.2 рекурсивно можно получить полное дерево тэгов.

Описание свойств элемента:
Last - указатель на последний вложенный элемент.
Name - название тэга (в верхнем регистре)
TagDisabled - флаг, указывающий что тэг отключен (его имя начинается с !), либо тэг является комментарием (имя равно "!--").
TagPosStart - позиция начала тэга, нумерация начинается с единицы.
TagPosEnd - позиция конца тэга, нумерация начинается с единицы.
TagOpen - тэг является парным и у него имеется открывающий тэг.
TagOpenPosStart - позиция начала открывающего тэга (позиция на символ <).
TagOpenPosEnd - позиция конца открывающего тэга (позиция на символ >).
TagClose - тэг является парным и у него имеется закрывающий тэг.
TagClosePosStart - позиция начала закрывающего тэга.
TagClosePosEnd - позиция конца закрывающего тэга.
TagValue - флаг, указывающий что у парного тэга имеется значение (текст между открывающим и закрывающим тэгом).
TagValuePosStart - позиция начала значения.
TagValuePosEnd - позиция конца значения.
Text - текст значения тэга; заполняется если была указана опция StoreText (игнорируются все тэги, упрощаются специальные символы, убираются дополнительные пробелы).
Attributes - атрибуты (параметры) тэга; заполняется, если была указана опция AutoParseTag.

Имеется три основных функции.

ParseHTML(HTML As String, ByRef Tags() As TagsType, Optional ByVal AutoParseTag As Boolean = False, Optional ByVal StoreText As Boolean = False)
Основная функция, осуществляющая разбор HTML-документа.
Исходный текст HTML-документа передается в HTML (значение переменной не изменяется в процедуре), вывод осуществляется в массив Tags(), все указатели в этом массиве ссылаются на HTML.

ParseTag(TagHTML As String, ByRef Tag As TagType, Optional ByVal CompactAttributes As Boolean = False)
Функция, осуществляющая разбор конкретного тэга. Текст тэга передается в HTML (значение переменной не изменяется в процедуре), вывод осуществляется в переменную Tag. Если параметр CompactAttributes будет задан, то одинаковые атрибуты будут выведены только один раз, использовано будет последнее значение.

StripHTML(ByVal HTML As String, Optional ByVal StripEntities As Boolean = True, Optional ByVal StripTags As Boolean = True, Optional ByVal StripSpaces As Boolean = True, Optional ByVal StripLineFeeds As Boolean = False) As String
Функция, вырезающая из HTML-текста указанную информацию. При задании StripEntities все элементы типа &nbsp; &gt; и других будут заменены на свои значения. При указании StripTags будут вырезаны все тэги, останется только текст внутри тэгов. При указании StripSpaces будут вырезаны все дополнительные пробелы (пробелами считаются также символы табуляции и перевода строки), 2 и более пробела будут объединены в один. При указании StripLineFeeds в качестве пробелов будут рассмотрены и тэги <P>, <BR> и <HR>.



В процедуре ParseHTML автоматически осуществляется разбор тэгов (загрузка атрибутов тэгов) и загрузка текста тэга. Кроме того, осуществляется отладочный вывод в файлы C:\output.htm и C:\output.tab. Все это осталось потому что проект не закончен.
В приложении обычно этого не требуется и отключение указанных особенностей ускорит работу парсера в несколько раз.


Дисклаймер.
По функциональным возможностям парсер конечно уступает MSHTML, и значительно.
С другой стороны, несмотря на то, что он почти не оптимизировался, он работает на два порядка быстрее парсера от Microsoft. Лично для меня это вполне достаточное удобство. Возможно, что и для других тоже.


[EDIT 2007-12-10]
Добавлена альтернативная версия парсера.
Добавлены методы:

Код: Выделить всё

Public Function GetChildren(lTags() As TagsType, PIndex As Long) As TagsType()
Public Function GetElementByID(lTags() As TagsType, ByVal ID As String) As TagsType
Public Function GetElementsByName(lTags() As TagsType, ByVal Name As String, Optional ByVal PIndex As Long = 1) As TagsType()
Public Function GetElementsByTagName(lTags() As TagsType, ByVal TagName As String, Optional ByVal PIndex As Long = 1) As TagsType()
Public Function GetAttribute(ByVal lTag As TagsType, ByVal Param As String) As Variant


Автор: Antonariy

[Antonariy]

Хочу поздравить парсер с приближающимся днем рождения и пожелать ему дойти до ума наименее длинной дорожкой

Хотелось бы сделать пару замечаний по этому поводу:
1) Неправильно парсятся теги SCRIPT и STYLE - при наличии знака "меньше" (<) в их текстах, закрывающий тег там и находится. Это лечится просто:

Код: Выделить всё

Dim IsScript As Boolean
Dim IsStyle As Boolean
'...
    Do Until P0 > Len(HTML) 'код автора
        If IsScript Then
            P = InStr(P0, HTML, "</script", vbTextCompare)
        ElseIf IsStyle Then
            P = InStr(P0, HTML, "</style", vbTextCompare)
        ElseIf
            P = InStr(P0, HTML, TagStart)
        End If
        If P = 0 Then Exit Do  'код автора
'...
        TagName = Left$(S, InStr(S, vbSpace) - 1)  'код автора
        IsScript = UCase(TagName) = "SCRIPT" And (Not fTagClosing)
        IsStyle = UCase(TagName) = "STYLE" And (Not fTagClosing)
'...

2)Это замечание более концептуальное. В свете своей излишней заумности, MSHTML имеет следующий каприз: если в правиле css-класса используется expression, то outerHTML элемента с таким классом возвращается с аттрибутом STYLE, имеющим фиксированное значение свойства, вычисленное из expression'а!!! Естественно, парсить стиль и вычищать самодеятельность MSHTML бессмыссленно, если заодно вручную был задан и аттрибут STYLE. Поэтому приходится сначала с помошью XMLHTTP получать html, парсить альтернативно, а потом уж навигатить туда же IE. Так что объектно работаю с MSHTML, а шаблоны-строки получаю с помощью данного парсера.

Предполагалость, что индекс элемента массива тегов соответствует sourceIndex'у соответствующего элемента из document.all, однако это не так в случае с таблицами. Этот парсер работает в лоб - что есть в тексте, то попадет в массив, но MSHTML дополняет структуру таблицы пропущенными тегами. Например, можно описать таблицу так:

Код: Выделить всё

<table><td></td><td></td></table>

A MSHTML дополнит ее до:

Код: Выделить всё

<table><tbody><tr><td></td><td></td></tr></tbody></table>

Хотелось бы, чтобы этот парсер тоже научился так делать. Пусть добавляет в массив пропущенные TBODY и TR, а их координаты в строке могут соответствовать следующим за ними тегам.

Парсер не самый простой для понимания (моего), поэтому дополнить его этой фишкой так же просто, как 1), не смогу. А нужно очень. Можно добавить параметр в процедуру типа "дополнять в соответствии с MSHTML", чтобы не обижать тех, кому оно не надо

PS: Иерархическая структура в отрыве от IE, который работает с MSHTML, не особо нужна.

[alibek]

Хм... Сложновато
Т.е. можно, конечно, но я только сейчас узнал про tbody
А значит придется спецификации HTML 4.01 изучать.

[Antonariy]

Не надо
Лучше я буду сам сообщать о найденных отличиях.
Еще одно отличие, на которое в общем-то наплевать, парсинг <!DOCTYPE >. У тебя название тега "DOCTYPE", у MSHTML - "!".

Если ты помнишь, как работает твой алгоритм, то для тебе не должно представить сложности добавить такие проверки:
Если текущий тег TR, то проверить предыдущий, если он TABLE, то добавить в массив перед текущим тег TBODY.
Если текущий тег TD, то если предыдущий - TABLE, то добавить TBODY и TR, а если THEAD, TBODY или TFOOT, то добавить только TR.

А в принципе координаты можно вообще не писать. Это будет означать, что в исходнике этих тегов не было.

[alibek]

С DOCTYPE сделано так специально.
Я так понял, что восклицательный знак вначале тэга отключает тэг. Т.е. первый тэг будет DOCTYPE, а TagDisabled=True.
А что касается добавляемых тэгов, то надо придумать, на что они будут ссылаться. Т.е. чему будут равны PosStart и PosEnd -- нулю или равны друг-другу и началу следующего тэга? Помоему правильнее их приравнивать нулю, но тогда при обходе тэгов надо будет дополнительно проверять значения, чтобы не наткнуться на ошибку в Mid$().

И вообще, я где-то из этого кирпича объектную модель делал, надо будет в архивах поискать. Чуток медленнее, но зато не будет проблем с обходом и построением дерева тэгов.

[alibek]

Вот, нашел.
Пример использования:

Код: Выделить всё

Set objDocument = New Document
objDocument.Parse HTML
...
objDocument.CleanUp
Set objDocument = Nothing


Только я не помню, на чем я там остановился и что недоделал. Помоему у меня циклические ссылки оставались.
Вообщем завтра помедитирую и повспоминаю, насколько он рабочий.

[Antonariy]

В общем покумекал я, да и сделал сам, что хотел
IsScript = и IsStyle = убрал, а в конец цикла добавил

Код: Выделить всё

        If Not fTagClosing Then
            Select Case UCase(TagName)
                Case "SCRIPT": IsScript = True
                Case "STYLE": IsStyle = True
                Case "TD", "TH"
                    Select Case Tags(N - 1).Name
                        Case "THEAD", "TBODY", "TFOOT"
                            Tags(N + 1) = Tags(N)
                            Tags(N).Name = "TR"
                            TagsCount = TagsCount + 1
                        Case "TABLE"
                            Tags(N + 2) = Tags(N)
                            Tags(N + 1).Name = "TR"
                            Tags(N).Name = "TBODY"
                            TagsCount = TagsCount + 2
                        End Select
                Case "TR"
                    If Tags(N - 1).Name = "TABLE" Then
                        Tags(N + 1) = Tags(N)
                        Tags(N).Name = "TBODY"
                        TagsCount = TagsCount + 1
                    End If
            End Select
        Else
            IsScript = False
            IsStyle = False
        End If

С позициями решил ничего не делать, все и так работает.

Иерархическую структуру гляну, тоже придумал ей применение. Оригинальную структуру некоторых кусков документа приходится хранить в пустых документах, а после вытаскивания их текстов MSHTML гадски правит ссылки например в рисунках - если стоит относительная ссылка, то добавляестя в качестве корня "about:blank" в 6м ie и "about:" в 7м.

ADD: Посмотрел. Во-первых "дети" по-английски не "childs", а "children", а во-вторых в архиве отсутствует класс TextStore, из-за чего он не работает.

[alibek]

Сорри, недоглядел

[Antonariy]

HTMLDoc ужасен... Видимо он затачивался под какую-то специфическую задачу, так как в нем много лишнего. И в то же время остались детские болезни типа кривого парсинга SCRIPT и STYLE. Не говоря уж об соответствии с MSHTML. А добавление объектной модели сказалось не лучшим образом на производительности.

Взял на себя смелость добавить безобъектную иерархию в первый вариант парсера. Ну и соответственно исправить указанные выше недочеты.

Код: Выделить всё

Public Function GetChildren(lTags() As TagsType, PIndex As Long) As TagsType()
Public Function GetElementByID(lTags() As TagsType, ByVal ID As String) As TagsType
Public Function GetElementsByName(lTags() As TagsType, ByVal Name As String, Optional ByVal PIndex As Long = 1) As TagsType()
Public Function GetElementsByTagName(lTags() As TagsType, ByVal TagName As String, Optional ByVal PIndex As Long = 1) As TagsType()
Public Function GetAttribute(ByVal lTag As TagsType, ByVal Param As String) As Variant

Optional ByVal PIndex - индекс элемента, потомков которого нужно просматривать. Другими словами - document.all(PIndex).getElementsByTagName(TagName). И не стоит забывать, IHTMLElementCollection начинается с индекса 0, а lTags() c 1.

Ах да, убрал StripHTML за ненадобностью.