站长论坛

 找回密码
 注册
查看: 4111|回复: 7

[分享]历史上的今天插件

[复制链接]
 楼主| 发表于 2006-8-31 18:00:50 | 显示全部楼层 |阅读模式
将代码另存为ASP文件,放到论坛根目录,后台添加插件即可!


  1. <!-- #include file="Inc.asp"-->
  2. <%
  3. If Not BBS94KK.Founduser Then BBS94KK.GoToErr(10)
  4. Call BBS94KK.Head("紫莎雅阁------历史上的今天")
  5. select case request("action")
  6. case "select"
  7.   showselect
  8. case "search"
  9.   showsearch
  10. case "item"
  11.   showitem
  12. case else
  13.   showtoday
  14. end select
  15. &#39;显示缺省页面
  16. Function showtoday
  17. dim lsstart,lsend,lsstr,lstemp,Title,Content
  18. lsstr=getHTTPPage("[url]http://www1.wst.net.cn/scripts/flex/TodayOnHistory/[/url]")
  19. lsstart=instr(lsstr,"<font color=""white"">历史上的</font>")
  20. lsend=instr(lsstr,"日")+1
  21. lstemp=mid(lsstr,lsstart,lsend-lsstart)
  22. Title=Replace(lstemp,"color=""white""","color=""#000000""")
  23. Content= "<tr><td class=TableBody2 colspan=2>  输入关键字查询:<input name=keyword size=20><input type=button value=搜索 onclick=""window.location=&#39;Today.asp?action=search&keyword=&#39;+keyword.value"">    选择日期查询:<select size=1 name=month>"
  24. dim iLoop
  25. for iLoop=1 to 12
  26.   content=content& "<option value=" & iLoop & ">" & iLoop & "</option>"
  27. next
  28.   content=content& "</select>月<select size=1 name=day>"
  29. for iLoop=1 to 31
  30.   content=content& "<option value=" & iLoop & ">" & iLoop & "</option>"
  31. next
  32. content=content& "</select>日<input type=button value=确定 onclick=""window.location=&#39;Today.asp?action=select&month=&#39;+month.value+&#39;&day=&#39;+day.value""></td></tr>"
  33. lsstart=instr(lsstr,"<a")
  34. lsend=instr(lsstr,"</a></td>") + 4
  35. lstemp=mid(lsstr,lsstart,lsend-lsstart)
  36. lstemp=replace(lstemp,"href=&#39;[url]http://www.wst.net.cn/history/[/url]","href=&#39;Today.asp?action=item&ls=")
  37. lsstart=instr(lsstr,"<td width=""165"" valign=""top"" align=""center"">")
  38. lsend=instr(lsstr,"</center></div>")
  39. lsstr=mid(lsstr,lsstart,lsend-lsstart-8)
  40. lsstr=replace(lsstr,"<td width=""165"" valign=""top""","<td class=tablebody1")
  41. lsstr=replace(lsstr,"<td width=""403"" valign=""top"" class=""a"">","<td class=tablebody1>" & lstemp & "<hr>")
  42. lsstr=replace(lsstr,"href=&#39;[url]http://www.wst.net.cn/history/[/url]","href=&#39;Today.asp?action=item&ls=")
  43. lsstr=replace(lsstr,"<a","<a style=&#39;color:#0000FF&#39;")
  44.   Call BBS94KK.ShowTable(Title,Content&"<tr>"&lsstr)
  45. end function
  46. &#39;显示选择的其它日期页面
  47. Function showselect
  48. dim lsstart,lsend,lsstr,lstemp,Title,Content
  49. lsstr=postHTTPPage("[url]http://www1.wst.net.cn/scripts/flex/TodayOnHistory/query.asp[/url]","month=" & request("month") & "&day=" & request("day"))
  50. lsstart=instr(lsstr,"<font color=""white"">历史上的</font>")
  51. lsend=instr(lsstr,"日")+1
  52. lstemp=mid(lsstr,lsstart,lsend-lsstart)
  53. Title=Replace(lstemp,"color=""white""","color=""#000000""")
  54. Content= "<tr><td colspan=2>  输入关键字查询:<input name=keyword size=20><input type=button value=搜索 onclick=""window.location=&#39;Today.asp?action=search&keyword=&#39;+keyword.value"">    选择日期查询:<select size=1 name=month>"
  55. dim iLoop
  56. for iLoop=1 to 12
  57.   Content=Content& "<option value=" & iLoop & ">" & iLoop & "</option>"
  58. next
  59. Content=Content& "</select>月<select size=1 name=day>"
  60. for iLoop=1 to 31
  61.   content=content& "<option value=" & iLoop & ">" & iLoop & "</option>"
  62. next
  63. content=content& "</select>日<input type=button value=确定 onclick=""window.location=&#39;Today.asp?action=select&month=&#39;+month.value+&#39;&day=&#39;+day.value""></td></tr>"
  64. lsstart=instr(lsstr,"<a")
  65. lsend=instr(lsstr,"</a></td>") + 4
  66. lstemp=mid(lsstr,lsstart,lsend-lsstart-8)
  67. lstemp=replace(lstemp,"href=&#39;[url]http://www.wst.net.cn/history/[/url]","href=&#39;Today.asp?action=item&ls=")
  68. lsstart=instr(lsstr,"<td width=""165"" valign=""top"" align=""center"">")
  69. lsend=instr(lsstr,"</center></div>")
  70. lsstr=mid(lsstr,lsstart,lsend-lsstart)
  71. lsstr=replace(lsstr,"<td width=""165"" valign=""top""","<td class=tablebody1")
  72. lsstr=replace(lsstr,"<td width=""403"" valign=""top"" class=""a"">","<td class=tablebody1>" & lstemp & "<hr>")
  73. lsstr=replace(lsstr,"href=&#39;[url]http://www.wst.net.cn/history/[/url]","href=&#39;Today.asp?action=item&ls=")
  74. lsstr=replace(lsstr,"<a","<a style=&#39;color:#0000FF&#39;")
  75. Call BBS94KK.ShowTable(Title,Content&"<tr>"&lsstr)
  76. end function
  77. &#39;显示显示搜索结果页面
  78. Function showsearch
  79.   on error resume next
  80. dim lsstart,lsend,lsstr,lstemp
  81. lsstr=postHTTPPage("[url]http://www1.wst.net.cn/scripts/flex/TodayOnHistory/search.asp[/url]","keyword=" & server.URLEncode(request("keyword")))
  82. lsstart=instr(lsstr,"查询结果>>>") + 35
  83. lsend=instr(lsstr,"</td></tr></table></center><center class=&#39;c&#39;>")
  84. lsstr=mid(lsstr,lsstart,lsend-lsstart)
  85. lsstr=replace(lsstr,"href=&#39;[url]http://www.wst.net.cn/history/[/url]","href=&#39;Today.asp?action=item&ls=")
  86. lsstr=replace(lsstr,"<a","<a style=&#39;color:#0000FF&#39;")
  87. if err.number<>0 then Response.write "未查询到数据或者网络故障,请稍后再查询":response.end
  88. Call BBS94KK.ShowTable("搜索到的和[<font color=#FF0000>" & request("keyword") & "</font>]相关的结果",lsstr)
  89. end function
  90. &#39;显示具体条目
  91. Function showitem
  92. dim lsstr
  93.   on error resume next
  94. lsstr=getHTTPPage("[url]http://www.wst.net.cn/history/[/url]" & request("ls"))
  95. lsstr=replace(lsstr,"<table border=""0"" width=""580"">","<table align=center>")
  96. lsstr=replace(lsstr,"</font><br>","</font><br><br>")
  97. lsstr=replace(lsstr,"<img src=""","<img src=""[url]http://www.wst.net.cn/history/[/url]" & mid(request("ls"),1,instr(request("ls"),"/")))
  98. lsstr=replace(lsstr,"<img SRC=""","<img src=""[url]http://www.wst.net.cn/history/[/url]" & mid(request("ls"),1,instr(request("ls"),"/")))
  99.   if err.number<>0 then Response.write "未查询到数据或者网络故障,请稍后再查询":response.end
  100. Call BBS94KK.ShowTable("历史上的今天",lsstr)
  101. end function
  102. Function getHTTPPage(url)
  103. dim http
  104. set http=Server.createobject("Microsoft.XMLHTTP")
  105. Http.open "GET",url,false
  106. Http.send()
  107. if Http.readystate<>4 then
  108.   exit function
  109. end if
  110. getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
  111. set http=nothing
  112. End function
  113. Function PostHTTPPage(url,strForm)
  114. dim http
  115. set http=Server.createobject("Microsoft.XMLHTTP")
  116. Http.open "POST",url,false
  117. http.setRequestHeader "Content-Length",len(strForm)
  118.    http.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
  119. Http.send(strForm)
  120. if Http.readystate<>4 then
  121.   exit function
  122. end if
  123. PostHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
  124. set http=nothing
  125. End function
  126. Function BytesToBstr(body,Cset)
  127. dim objstream
  128. set objstream = Server.CreateObject("adodb.stream")
  129. objstream.Type = 1
  130. objstream.Mode =3
  131. objstream.Open
  132. objstream.Write body
  133. objstream.Position = 0
  134. objstream.Type = 2
  135. objstream.Charset = Cset
  136. BytesToBstr = objstream.ReadText
  137. objstream.Close
  138. set objstream = nothing
  139. End Function
  140. BBS94KK.Footer()
  141. Set BBS94KK=Nothing
  142. %>
复制代码

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2006-10-17 03:28:09 | 显示全部楼层
谢谢~!
发表于 2006-10-17 03:29:42 | 显示全部楼层
[DuDuMouth03]
发表于 2007-1-4 12:50:41 | 显示全部楼层
请教!我将代码复制,粘贴进新的写字板 ,起名叫today.asp,使用论坛地址/today.asp,无法访问!
是不是我哪里有问题?
谢谢!
发表于 2007-1-4 13:31:51 | 显示全部楼层
today.asp是在论坛目录下吗?,我传了一个附件 是我现在用的,没有错误你可以下载,覆盖看看。
发表于 2009-10-26 03:20:08 | 显示全部楼层
路 过, 看 看!这个论坛真不错!以后常来!

















盈利模式   www.mijian.net/yinglimoshi.html
发表于 2015-6-7 11:20:54 | 显示全部楼层


  这是什么?
发表于 2015-6-10 15:13:27 | 显示全部楼层

  很可能是煮的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

站长推荐上一条 /2 下一条

快速回复 返回顶部 返回列表