Algunas personas consideran el rastreador como un tesoro. Hasta ahora, algunas personas están vendiendo TND por dinero. Quizás lo que aparece a continuación sea un poco aburrido.
El siguiente no tiene la función de escribir en la biblioteca. Hemos llegado a este paso. La función de ingresar a la biblioteca es muy simple. Si es necesario, complétela usted mismo. Copie el código y ejecútelo directamente para ver el efecto.
URL tenue,List_PageCode,Array_ArticleID,i,ArticleID
Atenuar Content_PageCode, Content_TempCode
Dim Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Título del artículo atenuado, autor del artículo, origen del artículo, contenido del artículo
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)'Obtener los artículos del actual Enlaces de página de lista, separados por
Array_ArticleID = Split(List_PageCode,,)'Crear una matriz para almacenar los ID de los artículos
Para i=0 a Ubound(Array_ArticleID)-1
ArticleID = Array_ArticleID(i)'ID del artículo
Content_PageCode = getHTTPPage(http://www.webasp.net/article/&ArticleID) 'Obtener el contenido de la página del artículo
'==========Obtenga la categoría del artículo y los parámetros de identificación relacionados para comenzar=========================
Content_TempCode = RegExpText(Content_PageCode,<a href=/article/>Tutorial técnico</a> >> ,>> Contenido</td>,0)
Content_CategoryID = RegExpText(Content_PageCode,<a href='../class,/'>,1)
BorderID = Split(Content_CategoryID,,)(0)' ID de categoría
ClassID = Split(Content_CategoryID,,)(1)'ID de subclase
'==========Compruebe si existe la categoría principalInicio=================
'Si no existe lo guardamos en la base de datos
'==========Compruebe si existe la categoría principalEnd=================
'Respuesta.Escribir(BorderID & , & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'Nombre de categoría
ClassName = Split(Content_CategoryName,,)(1)'Nombre de subclase
'==========Compruebe si la subclase existeInicio=================
'Si no existe lo guardamos en la base de datos
'==========Compruebe si existe una subclase fin=================
'========== Finaliza la obtención de la clasificación del artículo y los parámetros de identificación relacionados =========================
'==========Obtenga el título y el contenido del artículo y comience============================== =
Título del artículo = RegExpText(Content_PageCode,<tr><td align=center bgcolor=#DEE2F5><strong>,</strong></td></tr>,0)
ArticleAuthor = RegExpText(Content_PageCode,<tr><td><span class=blue>Autor:</span>,</td></tr>,0)
ArticleFrom = RegExpText(Content_PageCode,<tr><td><span class=blue>Fuente:</span>,</td></tr>,0)
Contenido del artículo = RegExpText(Content_PageCode,<tr><td class=content style=WORD-WRAP: break-word id=zoom>,</td></tr>&VBCrlf& </table>&VBCrlf& </td></tr> </tabla>,0)
'==========Obtener el título del artículo y el contenido final===============================
Respuesta.Escribir(Título del artículo& <br /><br />)
Respuesta.Flush()
Próximo
Se adjuntan algunas funciones:
Función getHTTPPage(url)
SI(IsObjInstalled(Microsoft.XMLHTTP) = Falso)ENTONCES
Response.Write <br><br>El servidor no admite el componente Microsoft.XMLHTTP
Err.Borrar
Respuesta.Fin
FINALIZAR SI
En caso de error Continuar siguiente
http oscuro
ESTABLECER http=Servidor.CreateObject(Msxml2.XMLHTTP)
Http.open OBTENER, URL, Falso
http.enviar()
SI(Http.readystate<>4)ENTONCES
Función de salida
FINALIZAR SI
getHTTPPage=BytesToBSTR(Http.responseBody,GB2312)
ESTABLECER http=NADA
SI(Número de error<>0)ENTONCES
Response.Write <br><br>Error al obtener el contenido del archivo
'Respuesta.Fin
Err.Borrar
FINALIZAR SI
Función final
Función BytesToBstr(CodeBody,CodeSet)
Dim objStream
SET objStream = Servidor.CreateObject(adodb.stream)
objStream.Tipo = 1
objStream.Modo =3
objStream.Open
objStream.Escribir cuerpo de código
objStream.Posición = 0
objStream.Tipo = 2
objStream.Charset = Conjunto de códigos
BytesToBstr = objStream.ReadText
objStream.Cerrar
ESTABLECER objStream = NADA
Función final
'=================================================
'Función: Comprobar si el componente ha sido instalado
'Valor de retorno: Verdadero ---- Ya instalado
' Falso ---- no instalado
'=================================================
Función IsObjInstalled(objName)
En caso de error Continuar siguiente
IsObjInstalled = Falso
Error = 0
Prueba tenueObj
SET testObj = Server.CreateObject(objName)
SI (0 = Err) ENTONCES IsObjInstalled = Verdadero
ESTABLECER testObj = NADA
Error = 0
Función final
Función RegExpText(cadena,cadenaInicio,cadenaFin,n)
Dim regEx, Match, Matches, RetStr
SET regExp = Nueva expresión regular
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = Verdadero
regEx.Global = Verdadero
SET Coincidencias = regEx.Execute(string)
Para cada partido en partidos
SI(n=1)ENTONCES
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
DEMÁS
RetStr = RetStr & regEx.Replace(Coincidencia.Valor,$1)
FINALIZAR SI
Próximo
RegExpText = RetStr
ESTABLECER expresiones regulares = NADA
Función final