1. 斑斓网首页
  2. 系统软件

推荐！调用百度热榜，排行榜，实时热点，热门关键词，榜单热词的小程序

斑斓网站长 • • 系统软件 • 阅读 9311

推荐！调用百度热榜，排行榜，实时热点，热门关键词，榜单热词的小程序

大家或许有这样的要求，把百度的榜单内容搬到自己的网站上，充实一下内容，提供更优质的用户体验，其它这个非常简单，程序源码也不长，现在贴在下面，复制后保存成asp文件，放到服务器上就可以了。

访问baidutop.asp?id=top10，获得实时热点排行榜前50名，

访问baidutop.asp?id=weekhotspot，获得七日关注排行榜，

访问baidutop.asp?id=top_keyword，获得今日热门搜索排行榜前50名，

访问baidutop.asp?id=shishuoxinci，获得世说新词排行榜。

以下是源代码：

<%
‘本程序源自网络，由https://www.argb.net编辑整理
‘本程序完全免费共享，实例显示请浏览：http://www.sonovo.net
by=request.querystring(“by”)
if by=”” then
by = “top10”
end if
Response.Expires = 0
Response.expiresabsolute = Now() – 1
Response.addHeader “pragma”, “no-cache”
Response.addHeader “cache-control”, “private”
Response.CacheControl = “no-cache”
Response.Buffer = True
Response.Clear
Server.ScriptTimeOut=999999999
‘采集函数
Function getHTTPPage(url)
If IsNull(url)=True Then
response.Write(“请输入网址！”)
Exit Function
End If
On Error Resume Next
dim http
set http=Server.createobject(“MSXML2.XMLHTTP”)
Http.open “GET”,url,false
Http.send()
if Http.readystate<>4 then
response.Write(“该网页无法访问！”)
exit function
end if
GetHTTPPage=bytesToBSTR(Http.responseBody,”gb2312″)
Set Http=Nothing
If Err.number<>0 then
Response.Write “<div align=’center’><b>服务器获取文件内容出错</b></div>”
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
Function stripHTML(strHTML)
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = “<\/?[^>]*>”
strOutput = objRegExp.Replace(strHTML, “”)
strOutput = Replace(strOutput, “<“, “&lt;”)
strOutput = Replace(strOutput, “>”, “&gt;”)
strOutput = Replace(strOutput, CHR(32), “&nbsp;”)
strOutput = Replace(strOutput, CHR(9), “&nbsp;”)
strOutput = Replace(strOutput, CHR(34), “&quot;”)
strOutput = Replace(strOutput, CHR(39), “&#39;”)
strOutput = Replace(strOutput, CHR(13), “”)
strOutput = Replace(strOutput, CHR(10) & CHR(10), ” “)
strOutput = Replace(strOutput, CHR(10), ” “)
stripHTML = strOutput
Set objRegExp = Nothing
End Function
Dim Url,title,strhtml,strTmp_bd,strkey
dim objRegExp, Match, Matches,Html,skey
‘截取”上升最快Top50″部分的内容
Url=”http://top.baidu.com/buzz/”&by&”.html”
Html= GetHTTPPage(Url)
Set objRegExp = New Regexp     ‘ 建立正则表达式。
objRegExp.IgnoreCase = True    ‘设置是否区分字符大小写
objRegExp.Global = True        ‘设置全局可用性
objRegExp.Pattern = “(<td class=\””.*””\><a href=\””)(.*)(\””\>)(.*)(<\/a></td>)” ‘ 设置模式。
set Matches = objRegExp.Execute(Html) ‘执行搜索
For i=0 To Matches.count-1      ‘遍历匹配集合
Match = Replace(stripHTML(Match),””,””) ‘格式化html代码
title = title&(Matches(i).SubMatches(3)&”||”) ‘赋值Matches(i).SubMatches(3)内容给title
Next
Set objRegExp = Nothing
title=split(title,”||”)
for i=0 to ubound(title)-1
baidu=baidu&”<a href=’http://www.baidu.com/baidu?cl=3&tn=baidutop10&fr=top1000&wd=”&title(i)&”‘ target=’_blank’>”&title(i)&”</a> <br>”
next
baidu=baidu&”<iframe src=baidutop.asp?id=”&by&” width=0 height=0 scrolling=no frameborder=0>auto</iframe>”
‘生成静态文件
Set Fso = Server.CreateObject(“Scripting.FileSystemObject”)
If Not Fso.FolderExists(Server.MapPath(“/”)) Then
Fso.CreateFolder(Server.MapPath(“/”))
End If
set fw=fso.createtextfile(server.mappath(“/”&date&”.html”),true)
fw.writeline baidu
fw.close
set fr=nothing
set fw=nothing
set fso=nothing
response.Write “已经完成,请打开”&date&”.html页”
%>

原创文章，作者：斑斓网站长，如若转载，请注明出处：https://www.argb.net/recommended-baidu-is-called-hot-list-list-real-time-hot-spots-popular-keywords-list-of-hot-words-applet.html

赞 (0)
斑斓网站长斑斓网站长
0
上一篇 2011 年 09 月 14 日 pm 10:42
下一篇 2011 年 09 月 16 日 pm 6:51

相关推荐

  • IIS下WordPress伪静态规则，亲测可用，也就是本站所用的伪静态规则，服务器为IIS+FastCGI+PHP5.3.8

    IIS下Wordpress伪静态规则，亲测可用，也就是本站所用的伪静态规则，服务器为IIS+FastCGI+PHP5.3.8 本站的wordpress伪静态解决方案及过程 在“固定链接设置”里面选“自定义结构”，后面填上“/%postname%.html”，这个样式的固定链接 下面是伪静态规则：   # Helicon ISAPI_Rewrite …

    开发笔记 2011 年 10 月 25 日

  • 【网赚】百分之八十的人，网赚没有赚到钱，这是为什么？

    高手很多，日赚几百，月赚上万的人虽然不多，但也不少吧？但是80%的人都没 有赚到钱，不由得引起我们自己的反思，其实赚不到钱的大概都是新手，因为老 鸟的话，多多少少都有自己的赚钱路子。子涵就个人的小小经验给新手朋友分析 一下。

    系统软件 2011 年 08 月 06 日

  • 阿里COO张勇：电商+零售业=合作

    阿里COO：电商+零售业=合作 　《财经天下》周刊在阿里巴巴上市之前对其首席运营官张勇进行了一次访问。在访问中，张勇讲述了阿里巴巴集团在电子商务方面的思考。在同《财经天下》周刊的此次谈话中，涉及的话题包括电子商务对零售业的冲击、淘宝与天猫未来的危机、巴宝莉到天猫开店、阿里巴巴在移动端的作为、他们对待微信及微信对电子商务冲击的态度以及阿里巴巴上市对公司带来的影…

    系统软件 2014 年 07 月 05 日

  • 欢迎大家光临！

    欢迎大家光临！

    系统软件 2011 年 04 月 19 日
  • 百度和Google谷歌谁更懂中国传统文化？谁更懂七夕？ 系统软件

    百度和Google谷歌谁更懂中国传统文化？谁更懂七夕？

    农历的七月初七，是中国传统文化中牛郞和织女相会的日子，在这个充满传统和人情的中国古老节日里，百度和google谷歌的标识也换成了七夕图，不过相比较来看，是中国的百度更懂中国传统文化、更懂七夕，还是美国的google谷歌更懂中国传统文化、更懂七夕呢？ 下面把标识列出来供大家看下，相信您一定会得出和我一样的结论。 百度的七夕图标：google谷歌的七夕图标： 上…

    2011 年 08 月 06 日

  • 修改FTP端口，解决FTP攻击，系统日志MSFTPSVC警告信息的方法

    最近服务器老被攻击，出现下面这个警告信息： 事件类型:    警告事件来源:    MSFTPSVC事件种类:    无事件 ID:    100日期:        2011-10-1事件:        21:01:39用户:        N/A计算机:    myser描述:由于错误 登录失败: 未知的用户名或错误密码。 ，服务器无法登录 Windo…

    开发笔记 2011 年 10 月 01 日

  • MSE中文版官方下载地址

    MSE中文版官方下载地址 http://windows.microsoft.com/zh-CN/windows/products/security-essentials/download

    系统软件 2015 年 07 月 01 日

  • MYSQL 命令大全

    一、连接MYSQL。格式： mysql -h主机地址 -u用户名 －p用户密码1、连接到本机上的MYSQL。首先打开DOS窗口，然后进入目录mysql\bin，再键入命令mysql -u root -p，回车后提示你输密码.注意用户名前可以有空格也可以没有空格，但是密码前必须没有空格，否则让你重新输入密码.如果刚安装好MYSQL，超级用户root是没有密码的…

    开发笔记 2011 年 10 月 18 日

  • 苹果欲参与收购ARM，Intel将代工ARM芯片，对抗三星台积电

    ARM近期被收购的消息吸引着大家眼球，被软银收购过程中，又半路杀出个程咬金，苹果也想收购ARM，ARM可以移动界的最大功臣，没有ARM设计的芯片，就没有移动产业界的今天，被收购的结果，人个也感觉是惨了点，不过价格可不低，那可是350亿美元，不过，ARM今天又传出好消息，Intel与ARM达成协议，正式代工ARM的芯片，Intel是谁？为什么会代工ARM芯片呢…

    系统软件 2016 年 08 月 24 日

  • 淘链接不能登录了，是不是在结账啊，呵呵

    淘链接不能登录了，是不是在结账啊，呵呵，登录后转到验证页，又转到http://tj.e.phpwind.com了，老在这两个页面间循环跳转，就是跳转不到管理界面，真在结账？说好的，每月15号结账的哦，呵呵。 我试了IE，Firefox，都不行。

    系统软件 2011 年 05 月 14 日

发表回复

您的电子邮箱地址不会被公开。 必填项已用*标注

记住昵称、邮箱和网址，下次评论免输入