]]>... Нужно распарсить HTML документ средствами MSXML. Да, знаю криво и коряво и вообще так делать нельзя, ...
Xameleon, поясните, пожалуйста, в чем заключаются противопоказания?
]]>Первое с чем столкнулся уже давно, это то что htmlfile в ASP создаётся не с первого раза. Скрипт выдаёт ошибку с кодом 8000ffff без вменяемого описания. Для обхода этого "косяка" сделал цикл, который проверяет создание объекта. Проверять на Err.Number = 0 не получилось, т.к хоть со второго раза объект всё же создаётся, но ошибка при этом всё равно происходит. Поэтому оставил проверку на isObject.
On Error Resume Next
For i=1 to 10
Set document = CreateObject("htmlfile")
if isObject(document) Then
....
Exit Function
End if
Next
Следующей (недавней ошибкой, а вернее их массой) стало то, что перестал автоматически создаваться HTMLBody у document после выполнения кода
document.open
document.close
К этому добавились ещё ошибки при выполнении insertAdjacentHTML и даже document.write, что крайне меня расстроило. Точных подробностей и описаний ошибок не помню, но по виду они напоминали всё туже неопознанную ошибку.
Решил попробовать создавать HTMLBody искусствено и заполнить его нужным мне содержимым.
With document
.open
.close
.appendChild document.createElement("body")
.body.innerHTML = HTMLCode
End With
И о чудо, "рухлядь" всё таки завелась с третьего раза !
В итоге пока что пользуюсь кодом "на костылях":
<%@Language=VBScript CodePage=1251 %>
<%
Option Explicit
Dim HTMLCode, document
HTMLCode = "<html><body>TEST</body></html>"
Set document = createHTMLDocument(HTMLCode)
Response.Write document.body.outerHTML
Function createHTMLDocument(HTMLCode)
Dim document, i
On Error Resume Next
For i=1 to 10
Set document = CreateObject("htmlfile")
if isObject(document) Then
On Error Goto 0
With document
.open
.close
.appendChild document.createElement("body")
.body.innerHTML = HTMLCode
End With
Set createHTMLDocument = document
Exit Function
End if
Next
On Error Goto 0
Err.Raise vbObjectError,"createHTMLDocument","Can't create html document"
End Function
%>
P.S В принципе все эти костыли [вроде бы] убираются, если дать htmlfile-у повышенные права в службе компонентов, но как-то не доверяю я ему на столько, да и зачастую на бесплатных хостах кидаю скрипты, а там с правами жёстко - что дали, тем и пользуйся.
]]>с последним апдейтом мелкомягких, htmlfile перестал парсить HTML код в ASP. Не буду вдаваться в подробности.
htmlfile тоже победил. Нашёл уловку обходящую ошибку.
Было бы очень интерсно познакомиться со встретившимся затруднением и вашим решением!
]]><div id="pForm" style="border:dotted 1px;width:19em;">
<table style="background-color:yellow;">
<tr>
<th><img >
<th>Таблица 1
<table style="border:solid 1px;">
<tr>
<td>1.2.1.1
<th>1.2.1.2
<td>1.2.1.3
<tr>
<th>1.2.2.1
<td>1.2.2.2
<th>1.2.2.3
</table>
<th><a href="">Ссылка
<tr>
<td><img >
<th>
<table style="border:solid 1px;">
<tr>
<td><button id="b1">2.2.1.1
<th><button id="b2">2.2.1.2
<td><button id="b3">2.2.1.3
</table>
</table>
</table>
<p>Подвал формы
</div>
<p>Продолжение документа
Подправил немного под ИЕ, чтобы не приводить стиль из того шедевра с кроссбраузерными хаками. Ну и отформатировал, как смог. Я не представляю ПРОСТОГО способа программно определить, куда ставить закрывающие теги. А ИЕ понимает... Сохраните это под именем kosyak.htm и откройте в ИЕ.
]]>к сожалению от ошибки с незакрытыми тегами пока не получается "отучить". А такие тэги часто встречаются - <base> <input> <img>
Допиливание HTML под MSXML с помощью наспех сооруженной функции msxmlcure(), которую я привожу ниже, позволило обойти ошибку незакрытых тегов. Но если провести тесты на текстах реальных страниц, то начинают валиться самые разнообразнейшие ошибки. Что-то подсказывает мне, что незакрытые теги будут далеко не единственной проблемой.
Option Explicit
Dim DOMDocument, raw, cured
raw = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"" ""http://www.w3.org/TR/html4/strict.dtd""></p><html><base>abc</div><head></head><!-- комментарий --><body><div>content<img src='http://yandex.st/www/1.675/yaru/i/logo.png'></body></html>"
' убрать пробелы в тегах после <
with createobject("VBScript.RegExp")
.global = true
.pattern = "<\s+"
raw = .replace(raw, "<")
end with
cured = msxmlcure(raw)
msgbox raw & vbcrlf & vbcrlf & cured, 64, "RESULT"
Set DOMDocument = HTMLToDOMDocument(cured)
msgbox "DOMDocument elts found: " & DOMDocument.getelementsbytagname("*").length
Function HTMLtoDOMDocument(htmlcode)
Dim DOMDocument: Set DOMDocument = CreateObject("Msxml2.FreeThreadedDOMDocument.6.0")
With DOMDocument
.validateOnParse = False
.resolveExternals = False
.PreserveWhiteSpace = True
.setProperty "ProhibitDTD",False
.setProperty "SelectionLanguage", "XPath"
.loadXml htmlcode
if .parseError <> 0 Then
With .parseError
Err.Raise .errorCode, "HTMLtoDOMDocument", .reason & vbCrlf & "line: " & .line & vbCrlf & "linePos:" & .linePos & vbCrlf & "srcText: " & .srcText
End With
End if
End With
Set HTMLtoDOMDocument = DOMDocument
End Function
function msxmlcure(text)
dim openmatches, closematches, opentag, closetag, tagname, pref, inner, tail
with createobject("VBScript.RegExp")
.pattern = "<[^>]+>" ' открывающий тег
set openmatches = .execute(text)
if openmatches.count > 0 then ' найден тег
set opentag = openmatches.item(0)
if mid(opentag.value, 2, 1) = "/" then ' это закрывающий тег
msxmlcure = msxmlcure(.replace(text, "")) ' удалить
else ' это открывающий тег
pref = left(text, opentag.firstindex)
if left(opentag.value, 2) = "<!" then ' это тег <! ...
inner = mid(text, opentag.firstindex + opentag.length + 1)
msxmlcure = msxmlcure(pref) & opentag.value & msxmlcure(inner)
else
with createobject("VBScript.RegExp")
.pattern = "\w+" ' имя тега
tagname = .execute(opentag.value).item(0).value
.pattern = "</" & tagname & ">" ' закрывающий тег
set closematches = .execute(text)
end with
if closematches.count > 0 then ' найден соответствующий закрывающий тег
set closetag = closematches.item(0)
inner = mid(text, opentag.firstindex + opentag.length + 1, closetag.firstindex - opentag.firstindex - opentag.length)
tail = mid(text, closetag.firstindex + closetag.length + 1)
msxmlcure = msxmlcure(pref) & opentag.value & msxmlcure(inner) & closetag.value & msxmlcure(tail)
else ' соответствующий закрывающий тег отсутствует
inner = mid(text, opentag.firstindex + opentag.length + 1)
msxmlcure = msxmlcure(pref) & left(opentag.value, opentag.length - 1) & " />" & msxmlcure(inner)
end if
end if
end if
else ' тег не найден
msxmlcure = text
end if
end with
end function
Option Explicit
Dim DOMDocument
Set DOMDocument = HTMLToDOMDocument("<html><base></body>content</body></body>")
Function HTMLtoDOMDocument(htmlcode)
Dim DOMDocument: Set DOMDocument = CreateObject("Msxml2.FreeThreadedDOMDocument.6.0")
With DOMDocument
.validateOnParse = False
.resolveExternals = False
.PreserveWhiteSpace = True
.setProperty "ProhibitDTD",False
.setProperty "SelectionLanguage", "XPath"
.loadXml htmlcode
if .parseError <> 0 Then
With .parseError
Err.Raise .errorCode, "HTMLtoDOMDocument", .reason & vbCrlf & "line: " & .line & vbCrlf & "linePos:" & .linePos & vbCrlf & "srcText: " & .srcText
End With
End if
End With
Set HTMLtoDOMDocument = DOMDocument
End Function
Наваял вот такую функцию, чтобы МАКСИМАЛЬНО "отговорить" MSXML ругаться на косяки HTML кода, т.к грузить html придётся с разных источников. Но к сожалению от ошибки с незакрытыми тегами пока не получается "отучить". А такие тэги часто встречаются - <base> <input> <img>
Предполагаю, что можно решить проблему через RegExp. Рою в этом направлении, но регулярки даются мне очень тяжко. В связи с этим прошу помощи / совета / рекомендации. Заранее очень благодарен. )
]]>