Algumas pessoas consideram o rastreador um tesouro. Até agora, algumas pessoas estão vendendo TND por dinheiro. Talvez o material abaixo seja um pouco idiota.
A função abaixo não tem a função de gravar na biblioteca. Chegamos a esta etapa. A função de entrar na biblioteca é muito simples, se necessário, você pode melhorar. Copie o código e execute-o diretamente para ver o efeito
Dim Url,List_PageCode,Array_ArticleID,i,ArticleID
Escurecer Content_PageCode,Content_TempCode
Dim Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Dim Título do Artigo,Autor do Artigo,ArtigoDe,Conteúdo do Artigo
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)'Obtenha os artigos do atual links da página da lista, separados por
Array_ArticleID = Split(List_PageCode,,)'Crie um array para armazenar IDs de artigos
Para i=0 para Ubound(Array_ArticleID)-1
ArticleID = Array_ArticleID(i)'ID do artigo
Content_PageCode = getHTTPPage(http://www.webasp.net/article/&ArticleID) 'Obtém o conteúdo da página do artigo
'==========Obtenha a categoria do artigo e os parâmetros de ID relacionados para iniciar========================
Content_TempCode = RegExpText(Content_PageCode,<a href=/article/>Tutorial Técnico</a> >> ,>> Conteúdo</td>,0)
Content_CategoryID = RegExpText(Content_PageCode,<a href='../class,/'>,1)
BorderID = Split(Content_CategoryID,,)(0)' ID da categoria
ClassID = Split(Content_CategoryID,,)(1)'ID da subclasse
'==========Verifique se a categoria principal existeIniciar================
'Se não existir, armazene-o no banco de dados
'==========Verifique se a categoria principal existeEnd================
'Response.Write(BorderID & , & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'Nome da categoria
ClassName = Split(Content_CategoryName,,)(1)'Nome da subclasse
'==========Verifique se a subclasse existeStart================
'Se não existir, armazene-o no banco de dados
'==========Verifique se a subclasse existe end================
'==========A obtenção da classificação do artigo e dos parâmetros de ID relacionados termina========================
'==========Obtenha o título e o conteúdo do artigo e comece============================== =
ArticleTitle = 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>Fonte:</span>,</td></tr>,0)
ArticleContent = RegExpText(Content_PageCode,<tr><td class=content style=WORD-WRAP: break-word id=zoom>,</td></tr>&VBCrlf& </table>&VBCrlf& </td></tr> </tabela>,0)
'==========Obter o título do artigo e o final do conteúdo==============================
Response.Write(ArticleTitle& <br /><br />)
Resposta.Flush()
Próximo
Em anexo estão algumas funções:
Função getHTTPPage(url)
SE(IsObjInstalled(Microsoft.XMLHTTP) = Falso)ENTÃO
Response.Write <br><br>O servidor não suporta o componente Microsoft.XMLHTTP
Err.Limpar
Resposta.Fim
TERMINAR SE
Em caso de erro, retomar o próximo
Escurecer http
DEFINIR http=Server.CreateObject(Msxml2.XMLHTTP)
Http.open GET,url,Falso
http.send()
SE(Http.readystate<>4)ENTÃO
Função de saída
TERMINAR SE
getHTTPPage=BytesToBSTR(Http.responseBody,GB2312)
DEFINIR http = NADA
SE(Err.número<>0)ENTÃO
Response.Write <br><br>Erro ao obter o conteúdo do arquivo
'Resposta.Fim
Err.Limpar
TERMINAR SE
Função final
Função BytesToBstr(CodeBody,CodeSet)
Dim objStream
DEFINIR 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.Fechar
DEFINIR objStream = NADA
Função final
'===============================================
'Função: Verifique se o componente foi instalado
'Valor de retorno: True ---- Já instalado
'Falso ---- não instalado
'===============================================
Função IsObjInstalled(objName)
Em caso de erro, retomar o próximo
IsObjInstalled = Falso
Errar = 0
Dim testeObj
SET testObj = Server.CreateObject(objName)
SE(0 = Err)ENTÃO IsObjInstalled = Verdadeiro
DEFINIR testObj = NADA
Errar = 0
Função final
Função RegExpText(strng,strStart,strEnd,n)
Dim regEx,Correspondência,Correspondências,RetStr
DEFINIR regEx = Novo RegExp
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = Verdadeiro
regEx.Global = Verdadeiro
SET Correspondências = regEx.Execute(strng)
Para cada partida nas partidas
SE(n=1)ENTÃO
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
OUTRO
RetStr = RetStr & regEx.Replace(Match.Value,$1)
TERMINAR SE
Próximo
RegExpText = RetStr
DEFINIR regEx=NADA
Função final