邪贴的金库吧 关注:167贴子:1,766
  • 2回复贴,共1

ASP采集代码(可截部分内容)

只看楼主收藏回复



1楼2011-12-16 15:30回复
    <%
    '功能:asp采集代码 url="http://news.163.com/09/0423/04/57IC37280001124J.html" str=getHTTPPage(url)
    title=strcut(str,"<h1 id=""h1title"">","</h1>",2)
    content=strcut(str,"手机看新闻</a></span>","(本文来源",2) response.write "新闻标题<br><b>"&title&"</b><br><br><br>新闻内容:<br>"&content
    '获取当前网址的源代码
    Function getHTTPPage(url)
    On Error Resume Next
    dim http
    set http=Server.createobject("Microsoft.XMLHTTP")
    Http.open "GET",url,false
    Http.send()
    if Http.readystate<>4 then
    exit function
    end if
    getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
    set http=nothing
    If Err.number<>0 then
    Response.Write "<p align='center'><font color='red'><b>服务器获取文件内容出错</b></font></p>"
    Err.Clear
    End If
    End Function
    Function BytesToBstr(body,Cset)
    dim objstream
    set objstream = Server.CreateObject("adodb.stream")
    objstream.Type = 1
    objstream.Mode =3
    objstream.Open
    objstream.Write body
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = Cset
    BytesToBstr = objstream.ReadText
    objstream.Close
    set objstream = nothing
    End Function
    '截取字符串,1.包括起始和终止字符,2.不包括
    Function strCut(strContent,StartStr,EndStr,CutType)
    Dim strHtml,S1,S2
    strHtml = strContent
    On Error Resume Next
    Select Case CutType
    Case 1
    S1 = InStr(strHtml,StartStr)
    S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)
    Case 2
    S1 = InStr(strHtml,StartStr)+Len(StartStr)
    S2 = InStr(S1,strHtml,EndStr)
    End Select
    If Err Then
    strCute = "<p align='center'>没有找到需要的内容。</p>"
    Err.Clear
    Exit Function
    Else
    strCut = Mid(strHtml,S1,S2-S1)
    End If
    End Function %>


    3楼2011-12-16 15:31
    回复
      配合:title=replace(title,"</STRONG>","")
      效果更佳


      4楼2011-12-26 13:51
      回复