В этой статье представлена обмен учебными пособиями на странице списка. Давайте посмотрим на подробное руководство ниже. Друзья, которые это нужно, могут ссылаться на это.
Некоторые люди - это сокровище, когда они ползают, но они все еще продают их за TND. Это действительно правда, что эти парни! Может быть, следующее немного плохо
Следующее не имеет функции записи в магазин, и она достигла этой точки. Функция входа очень проста. Пожалуйста, заполните это самостоятельно, если вам это нужно. Пожалуйста, улучшите другие функции самостоятельно! Скопируйте код и запустите его напрямую, чтобы увидеть эффект
DIM URL, list_pageCode, array_articleid, i, articleid
Dim content_pagecode, content_tempcode
Dim content_categoryid, content_categoryname, borderid, classid, bordername, classname
Dim articletitle, Articleauthor, статья от ArticleContent
Url = "http://www.webasp.net/article/class/1.htm"
List_pagecode = gethttppage (url)
List_pagecode = regexptext (list_pagecode, "print", "
List_pagecode = regexptext (list_pagecode, "Получите ссылку на статью текущей страницы списка, чтобы разделить ее
Array_articleid = split (list_pageCode, ",") 'Создайте массив и сохраните идентификатор статьи
Для i = 0 до ubound (array_articleid) -1
Articleid = array_arrayid (i) 'arrayid
Content_pagecode = gethttppage ("http://www.webasp.net/article/" & articeid) 'Получите содержимое страницы статьи
'============================================================================
Content_tempcode = regexptext (content_pagecode, "Технический учебник >>", ">> content", 0)
Content_categoryid = regexptext (content_pagecode, "", 1)
Borderid = split (content_categoryid, ",") (0) 'Большой идентификатор класса
Classid = split (content_categoryid, ",") (1) 'идентификатор подкласса
'============== Проверьте, существует ли основная категория. Start =================
'Если его не существует, введите базу данных
'=============== Проверьте, существует ли основная категория END =============================================
'Response.write (borderid & "," & classid & "
")
Content_categoryname = regexptext (content_pagecode, "/'>", "", 1)
Bordername = split (content_categoryname, ",") (0) 'Название большого класса
Classname = split (content_categoryname, ",") (1) 'Имя подкласса
'============== Проверьте, существует ли подкласс запуск =======================================
'Если его не существует, введите базу данных
'=============== Проверьте, существует ли подкласс заканчивается ==========================================
'=============================================================================
'==================================================================
Articletitle = regexptext (content_pageDode, " ", " ", 0)
ArticLeauthor = regexpText (content_pageCode, "Автор:", "", 0)
Articlefrom = regexptext (content_pagecode, «Источник:», "", 0)
Articlecontent = regexptext (content_pagecode, "," "& vbcrlf &" "& vbcrlf &" ", 0)
'====================================================================
Response.write (articletitle & "
")
Response.flush ()
Следующий
Прикреплено несколько функций:
Функция gethttppage (url)If (isobjinstalled ("microsoft.xmlhttp") = false) then
Response.write "
Сервер не поддерживает компонент Microsoft.xmlhttp "
Err.clear
Response.end
Конец, если
При ошибке резюме следующим
Dim http
Установить http = server.createObject ("msxml2.xmlhttp")
Http.open "Get", url, false
Http.send ()
If (http.readystate4) тогда
Выходная функция
Конец, если
gethttppage = bytestobstr (http.responsebody, "gb2312")
Установите http = ничего
If (err.number0) тогда
Response.write "
Произошла ошибка при получении содержимого файла »
'Response.end
Err.clear
Конец, если
Конечная функция
Function Bytestobstr (Codebody, CodeSet)
Dim objstream
Установить objstream = server.createObject ("adodb.stream")
objstream.type = 1
objstream.mode = 3
objstream.open
objstream.write Codebody
objstream.position = 0
objstream.type = 2
objstream.charset = codeSet
Bytestobstr = objstream.readtext
objstream.close
Установить objstream = ничего
Конечная функция
'=========================================================================
'Function: проверьте, был ли компонент установлен
'Возвращение значения: true ---- Установлено
'False --- не установлен
'=========================================================================
Функция isobjinstalled (objname)
При ошибке резюме следующим
Isobjinstalled = false
Err = 0
Dim testobj
Установить testObj = server.createObject (objName)
If (0 = err) then isobjinstalled = true
Установить TestObj = ничего
Err = 0
Конечная функция
Функция regexptext (strng, strStart, strend, n)
Dim Regex, Match, Matches, Retstr
Set regex = new Regexp
regex.pattern = strstart & "([/s/s]*?)" & strend
regex.ignorecase = true
regex.global = true
Set matches = regex.execute (strng)
Для каждого матча в матчах
If (n = 1) тогда
Retstr = retstr & regex.replace (match.value, "$ 1") и ","
ЕЩЕ
Retstr = retstr & regex.replace (match.value, "$ 1")
Конец, если
Следующий
Regexptext = retstr
Установить regex = ничего
Выше приведено введение всего содержимого обмена учебными пособиями на пакетном ползании на определенной странице списка. Я надеюсь, что соответствующие знания и материалы, составленные редактором, будут полезны для вас. Для получения дополнительного контента, пожалуйста, продолжайте обращать внимание на веб -сайт канала Wuxin Technology Channel!