木子屋
 

标题: 【实战】采集某篇文章的标题

作者: dnawo

日期: 2006-12-17 00:27 AM

分类: Web编程

内容: 复制内容到剪贴板 程序代码<%
'编码转换
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
'获取全部内容
Function GetBody(weburl)
    Set Retrieval = CreateObject("Msxml2.ServerXMLHTTP")
    With Retrieval
        .Open "Get", weburl, False, "", ""
        .Send
        GetBody = .ResponseBody
    End With
    GetBody = BytesToBstr(GetBody,"GB2312")
    Set Retrieval = Nothing
End Function
'获取GetBody中指定内容
Function GetSpcBody(wstr,start,over)
    Dim RegEx
    Set RegEx = New Regexp'设置配置对象
    RegEx.IgnoreCase = True'忽略大小写
    RegEx.Global = True'设置为全文搜索
    RegEx.Pattern = "" & start & "(.+?)" & over & "" '正则表达式
    Set Matches =RegEx.Execute(wstr)'开始执行配置
    GetSpcBody=""
    For Each Match in Matches
    GetSpcBody = GetSpcBody & RegEx.replace(Match.Value,"$1") '循环匹配
    Next
    set RegEx=nothing
End Function
'获取某网址指定内容
Function GetBodyByUrl(weburl,start,over)
    GetBodyByUrl=GetSpcBody(GetBody(weburl),start,over)
End function
Dim content
content=GetBodyByUrl("http://article.rongshuxia.com/viewart.rs?aid=3913735","<title>","</title>")
response.write "该文章的标题为：" & content
%>
------------------------------------------------------------------------
2012-02-09：Microsoft.XMLHTTP改为Msxml2.ServerXMLHTTP。

+ 查看当前日志评论 (1)

 

登录

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms

标题: 【实战】采集某篇文章的标题

你没有权限发表评论

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms

暂无评论

返回

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms