@Alexey

Знаю, что писали уже где-то об этом, но что-то у меня не получается, так что не ругайтесь сильно... Проблема в следующем, есть скрипт http://www.relib.com/xml_test.asp который сдирает данные с другой страницы. Сдирает полностью, а мне надо только серединку, начиная от 'Документы 1 - 10 из 35' и заканчивая '[Вернуться на главную страницу Relib.com]'. Функцию использую следующую:

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function to return binary data
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function GetHTMLBin(strURL)
Dim objXMLHTTP, strReturn
Set objXMLHTTP = Server.CreateObject('Microsoft.XMLHTTP')

objXMLHTTP.Open 'GET', strURL, False
objXMLHTTP.Send Cstr(Rnd())

GetHTMLBin = objXMLHTTP.responseBody
Set objXMLHTTP = Nothing
End Function

Оригинал находится по адресу:

http://sitelevel.whatuseek.com/query.go?crid=1fa387c33db52314&query=iis&slice_title=site&page=&domain=&exclude= &autocustomize=

Что надо написать в Pattern, чтобы выдрать код как надо?

0

@t1k

Документы 1 - 10 из 35 (.|
)*[Вернуться на главную страницу Relib.com]

Я тебе и отвечал в прошлый раз.

0

@Alexey

okey, исправил процедуру на следующее:

Function GetHTMLBin(strURL)
Dim objXMLHTTP, strReturn
Set objXMLHTTP = Server.CreateObject('Microsoft.XMLHTTP')

objXMLHTTP.Open 'GET', strURL, False
objXMLHTTP.Send Cstr(Rnd())

Set oRegExp=CreateObject('VBScript.RegExp')
oRegExp.Global=True
oRegExp.IgnoreCase=True
oRegExp.Pattern='Документы 1 - 10 из 35 (.|
)*[Вернуться на главную страницу Relib.com]'
Set oMatches=oRegExp.Execute(objXMLHTTP.responseBody)

GetHTMLBin = oMatches.Item(0).SubMatches(0)
Set objXMLHTTP = Nothing
End Function

Результат следующий:

Error Type:
Microsoft VBScript runtime (0x800A0005)
Invalid procedure call or argument
/xml_test.asp, line 18

0

@Alexey

В 18-й строке написано следующее:

GetHTMLBin = oMatches.Item(0).SubMatches(0)

0

@t1k

Ну я ж тебе для примера написал pattern, там суть в том что (.|
)*. А ошибка это значит не нашел он ничего по этому образцу и коллекция пустая
Pattern примерно так выглядит
и.
(.|
)[В

0

@t1k

Сейчас проверил очень долго работает поиск регэкспа, что естественно, гораздо прагматичнее в твоем случае искать строку где начало и искать строку где конец - вот она по моему '<p align=center><a href=http://www.relib.com>'

РегЭкспы слабо эффективны при вырезании информации из больших текстов, да и в твоем случае это нужно по-моему. Лучше обойтись Left,Right,Mid,InStr

0

@Alexey

Спасибо, с Left,Right я попробую, чтобы сравнить быстродействие, но хочется добить этот RegExp, раз уж начал... попробовал и

oRegExp.Pattern='и.
(.|
)[В'

и

oRegExp.Pattern='До.
(.|
)<p align=center><a href=http://www.relib.com>'

результат одинаковый oMatches.Count=0

Сейчас код такой:

<%
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function to return binary data
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function GetHTMLBin(strURL)
Dim objXMLHTTP, strReturn
Set objXMLHTTP = Server.CreateObject('Microsoft.XMLHTTP')

objXMLHTTP.Open 'GET', strURL, False
objXMLHTTP.Send Cstr(Rnd())

Set oRegExp=CreateObject('VBScript.RegExp')
oRegExp.Global=True
oRegExp.IgnoreCase=True
oRegExp.Pattern='До.
(.|
)<p align=center><a href=http://www.relib.com>'
Set oMatches=oRegExp.Execute(objXMLHTTP.responseBody)

if oMatches.Count > 0 then
GetHTMLBin = RetStr & oMatches.Item(0).SubMatches(0)
else
GetHTMLBin = 'No records found'
end if
Set objXMLHTTP = Nothing
End Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function to convert binary data to text
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function BinToText(varBinData, intDataSizeInBytes) ' as String
Const adFldLong = &H00000080
Const adVarChar = 200
Set objRS = Server.CreateObject('ADODB.Recordset')

objRS.Fields.Append 'txt', adVarChar, intDataSizeInBytes, adFldLong
objRS.Open

objRS.AddNew
objRS.Fields('txt').AppendChunk varBinData
BinToText = objRS('txt').Value

objRS.Close
Set objRS = Nothing
End Function

Response.Write BinToText(GetHTMLBin('http://sitelevel.whatuseek.com/query.go?crid=1fa387c33db52314&query=iis&slice_title=&page=&domain=&exclude=&aut ocustomize='), 35000)
%>

Где проблема?

0

@t1k

Я сделал нормальный паттерн по которому можно вырезать информацию и проверил на этом сайте. Тормозит зверски. А фишка в том что надо вместо
ставить [
]

='и.[
](.|[
])*[В'

0

@Alexey

Может я чего не так делаю? Взгляни ;-(

http://www.relib.com/xml_test.asp

то же самое с твоей последней pattern

0

@t1k

Черт, оказалось не так уж зверски.

В файле a.html HTML того URL, который ты давал.

Set oRegExp=CreateObject('VBScript.RegExp')
With oRegExp
.Global=True
.IgnoreCase=True
.Pattern='и.[
]+(.|[
])*[В'
End With
Set oFSO=CreateObject('Scripting.FileSystemObject')
Set oFile=oFSO.OpenTextFile('a.html',1)
Data=oFile.ReadAll
Set oMatches=oRegExp.Execute(Data)
Set oFile=oFSO.CreateTextFile('b.html',2)
oFile.Write oMatches.Item(0)

0

@t1k

Ну че заработало? а то мне скоро домой уходить :-)

0

@Alexey

Слушай, последний пример работает, но там используется статический файл, который я по твоему примеру сделал и положил на сервер. А вот то что я посылал и пытался сделать - разбор на лету не работает, выдает 0 результатов и хоть ты тресни! Может быть проблема тут где-то?

Set oMatches=oRegExp.Execute(objXMLHTTP.responseBody)

Ладно, я еще поэкспериментирую и о результатах доложу :-) Спасибо за помощь!

0

@t1k

вроде все работает

Function GetHTMLBin(strURL)
Dim objXMLHTTP, strReturn
Set objXMLHTTP = CreateObject('Microsoft.XMLHTTP')

objXMLHTTP.Open 'GET', strURL, False
objXMLHTTP.Send Cstr(Rnd())

Set oRegExp=CreateObject('VBScript.RegExp')
oRegExp.Global=True
oRegExp.IgnoreCase=True
oRegExp.Pattern='и.[
]+((.|[
])*)[&#1042'
Set oMatches=oRegExp.Execute(BinToText(objXMLHTTP.responseBody,LenB(objXMLHTTP.respo nseBody)))

if oMatches.Count > 0 then
GetHTMLBin = RetStr & oMatches.Item(0).Submatches(0)
else
GetHTMLBin = 'No records found'
end if
Set objXMLHTTP = Nothing
End Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function to convert binary data to text
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function BinToText(varBinData, intDataSizeInBytes) ' as String
Const adFldLong = &H00000080
Const adVarChar = 200
Set objRS = CreateObject('ADODB.Recordset')

objRS.Fields.Append 'txt', adVarChar, intDataSizeInBytes, adFldLong
objRS.Open

objRS.AddNew
objRS.Fields('txt').AppendChunk varBinData
BinToText = objRS('txt').Value

objRS.Close
Set objRS = Nothing
End Function

MsgBox GetHTMLBin('http://sitelevel.whatuseek.com/query.go?crid=1fa387c33db52314&query=iis&slice_title=&page=&domain=&exclude=&aut ocustomize=')

0