Некоторые люди считают краулер сокровищем. До сих пор некоторые люди продают TND за деньги. Я сильно ругаю этих ребят за то, какие они есть! Возможно, то, что ниже, немного неубедительно.
В приведенном ниже нет функции записи в библиотеку. Мы дошли до этого шага. Функция входа в библиотеку очень проста. Если необходимо, вы можете улучшить другие функции. Скопируйте код и запустите его, чтобы увидеть эффект.
Тусклый URL-адрес, List_PageCode, Array_ArticleID, i, ArticleID
Тусклый Content_PageCode,Content_TempCode
Тусклый Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Тусклый ArticleTitle,ArticleAuthor,ArticleFrom,ArticleContent
URL = http://www.webasp.net/article/class/1.htm
List_PageCode = getHTTPPage (URL-адрес)
List_PageCode = RegExpText(List_PageCode, print</th></tr>,</table><table border=0 cellpadding=5,0)
List_PageCode = RegExpText(List_PageCode,<td align=left><a href='../,'><img border=0 src='../images/authortype0.gif',1)'Получить статьи текущего страница списка Ссылки, разделенные
Array_ArticleID = Split(List_PageCode,,)'Создайте массив для хранения идентификаторов статей.
Для i=0 к Ubound(Array_ArticleID)-1
ArticleID = Array_ArticleID(i)'Идентификатор статьи
Content_PageCode = getHTTPPage(http://www.webasp.net/article/&ArticleID) 'Получить содержимое страницы статьи
'==========Получите категорию статьи и соответствующие параметры идентификатора для запуска =======================
Content_TempCode = RegExpText(Content_PageCode,<a href=/article/>Техническое руководство</a> >> ,>> Content</td>,0)
Content_CategoryID = RegExpText(Content_PageCode,<a href='../class,/'>,1)
BorderID = Split(Content_CategoryID,,)(0)' Идентификатор категории
ClassID = Split(Content_CategoryID,,)(1)'ID подкласса
'==========Проверьте, существует ли основная категория. Начало================
'Если он не существует, сохраните его в базе данных
'==========Проверьте, существует ли основная категорияEnd================
'Response.Write(BorderID &, & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'Имя категории
ClassName = Split(Content_CategoryName,,)(1)'Имя подкласса
'==========Проверьте, существует ли подклассStart================
'Если он не существует, сохраните его в базе данных
'==========Проверьте, существует ли подкласс end===============
'==========Получение классификации статьи и связанных с ней параметров идентификатора заканчивается=======================
'==========Получите заголовок и содержание статьи и начните=========================== =
ArticleTitle = RegExpText(Content_PageCode,<tr><td align=center bgcolor=#DEE2F5><strong>,</strong></td></tr>,0)
ArticleAuthor = RegExpText(Content_PageCode,<tr><td><span class=blue>Автор:</span>,</td></tr>,0)
ArticleFrom = RegExpText(Content_PageCode,<tr><td><span class=blue>Источник:</span>,</td></tr>,0)
ArticleContent = RegExpText(Content_PageCode,<tr><td class=content style=WORD-WRAP: разрыв слова id=zoom>,</td></tr>&VBCrlf& </table>&VBCrlf& </td></tr> </таблица>,0)
'==========Получите заголовок и содержание статьи ============================
Response.Write(Название статьи& <br /><br />)
Ответ.Flush()
Следующий
Прилагается несколько функций:
Функция getHTTPPage(url)
ЕСЛИ(IsObjInstalled(Microsoft.XMLHTTP) = False)ТО
Response.Write <br><br>Сервер не поддерживает компонент Microsoft.XMLHTTP.
Ошиб.Очистить
Ответ.Конец
КОНЕЦ ЕСЛИ
При ошибке Возобновить Далее
Тусклый http
SET http=Server.CreateObject(Msxml2.XMLHTTP)
Http.open GET,url,False
HTTP.send()
ЕСЛИ(Http.readystate<>4)ТО
Выход из функции
КОНЕЦ ЕСЛИ
getHTTPPage = BytesToBSTR (Http.responseBody, GB2312)
УСТАНОВИТЬ http=НИЧЕГО
ЕСЛИ(номер ошибки<>0)ТО
Response.Write <br><br>Ошибка при получении содержимого файла
'Ответ.Конец
Ошиб.Очистить
КОНЕЦ ЕСЛИ
Конечная функция
Функция BytesToBstr(CodeBody,CodeSet)
Тусклый объектный поток
SET objStream = Server.CreateObject(adodb.stream)
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream. Напишите CodeBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = Набор кодов
BytesToBstr = objStream.ReadText
objStream.Close
УСТАНОВИТЬ objStream = НИЧЕГО
Конечная функция
'==============================================
'Функция: Проверить, установлен ли компонент
'Возвращаемое значение: True ---- Уже установлено
' Ложь ---- не установлено
'==============================================
Функция IsObjInstalled(objName)
При ошибке Возобновить Далее
IsObjInstalled = Ложь
Ошибка = 0
Тусклый тестObj
SET testObj = Server.CreateObject(objName)
ЕСЛИ(0 = Ошибка)ТО IsObjInstalled = Истина
УСТАНОВИТЬ testObj = НИЧЕГО
Ошибка = 0
Конечная функция
Функция RegExpText(strng,strStart,strEnd,n)
Dim regEx,Match,Matches,RetStr
SET regEx = Новое регулярное выражение
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = Истина
regEx.Global = Истина
SET Matches = regEx.Execute(strng)
За каждый матч в матчах
ЕСЛИ(n=1)ТО
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
ЕЩЕ
RetStr = RetStr & regEx.Replace(Match.Value,$1)
КОНЕЦ ЕСЛИ
Следующий
РегЭкспТекст = РетСтр
УСТАНОВИТЬ регулярное выражение = НИЧЕГО
Конечная функция