不能谋万世者，不足谋当时。我蛮夷也，言语不偏激，不足以触动人心。狂夫之语，圣人择善而从。此处兜售战略、谋攻、时事、思想、历史、地理、科技、文化、治国之道。我的RSS分享网址是http://www.kanurl.com
查看文章 |
自动定时采集RSS资源的示例程序
2009年01月30日 星期五 下午 09:19
 这个表AS_LogClass存RSS源
这个表Timer记录每个RSS源最后一次采集时间
以下是定时自动获取的核心程序： Sub timer_AutoGetLog() '==自动定时获取RSS资源到日志:如果上次更新距现在相距3600秒钟[60分钟],则获取新RSS资源更新日志=====LogClassID父栏目编号,ChildLogClassID子栏目编号 If Application("isAutoGetOK")=False Then Application.Lock() Application("isAutoGetOK")=True '采集完毕标志 Application.UnLock() If Request("LogClassID")<>"" Then LogClassID=Clng(Request("LogClassID")) Else LogClassID=1 If Request("ChildLogClassID")<>"" Then ChildLogClassID=Clng(Request("ChildLogClassID")) Else ChildLogClassID=LogClassID Set Rs_Timer =Server.CreateObject("ADODB.RecordSet") Rs_Timer.Open ("Select Top 1 * From Timer Where LogClass_ID="&ChildLogClassID&""),ConnSite,1,3 If Rs_Timer.EoF Then Rs_Timer.AddNew Rs_Timer("LogClass_ID")=ChildLogClassID Call GetRssContent(LogClassID,ChildLogClassID) '获取指定编号RSS资源并生成静态页 Rs_Timer("MakeDateTime")=Now() Else If datediff("s",Rs_Timer("MakeDateTime"),Now())>3600 Then '这是定时间隔 Call GetRssContent(LogClassID,ChildLogClassID) '获取指定编号RSS资源并生成静态页 Rs_Timer("MakeDateTime")=Now() End If End If Rs_Timer.UpDate Rs_Timer.Close Set Rs_Timer=Nothing Application.Lock() Application("isAutoGetOK")=False '采集完毕标志 Application.UnLock() End If '=自动定时获取RSS资源到日志完毕=================================================================== End Sub '获取RSS资源内容函数---------------------------------------------------- Function GetRssContent(LogClassID,ChildLogClassID) '从RSS资源里采集博客日志到我的博客 'on error resume next %> <% response.Buffer=true isShowContent=1 'isShowContent=1显示内容描述，=0只显示标题 strCss="<style type=text/css>.rss_content{ text-align:left;font-size:14px; border: thin #009900; padding:3 3; margin:3 0; width:100%; overflow:hidden; clear:both; float:left;}.rss_title{font-weight: bold;color:#FF0000; font:黑体; font-weight:100; font-size:14px;}a.rss_link{ text-decoration:none; color:#009900; font-weight:bold; font-size:14px; text-shadow:#99CCCC;}a.rss_link:visited{text-decoration:none; color:#009900; font-weight:bold; font-size:14px;}.rss_description{ clear:both;}.rss_author{ color:#00CCFF;float:left; margin:0 10px;}.rss_pubdate{ float:right;color:#FF0000;}.rss_comments{ float:left;}.rss_category{ color:#FF9900; float:left; margin:0 10px;}.rss_guid{ color:#339966;clear:both;}.rss_enclosure{ clear:both;}.rss_image{ float:left;}.rss_other{ float:left; clear:right;}.rss_line{ border-bottom:dashed #33CC66 1px; clear:both;}</style>" '获取样式表 sql="select top 1 * from AS_LogClass Where LogClass_ID=" & ChildLogClassID Set Rs = ASCore.Execute(sql) If Not(Rs.Eof) Then RssUrl=server.HtmlEncode(Rs("strRssHref")) 'Rss新闻订阅的URL strRssTitle=server.HtmlEncode(Rs("LogClass_Name")) 'Rss新闻分栏标题 LogClass_LogHtml=Rs("LogClass_LogHtml") '分栏是否生成静态页'1'为允许 Rs.close Else Rs.close Response.Write("没有指定LogClass_ID编号，无法继续！") Response.End() End If If RssUrl=Empty Then RssUrl="http://hi.baidu.com/天下第九/rss" txtlength=request("txtlength") '新闻标题长度 If txtlength<>"" Then txtlength=Cint(txtlength) Else txtlength=Empty keyword=Request("keyword") 'Rss新闻关键字 If keyword<>"" Then RssUrl="http://news.baidu.com/ns?word=" & keyword & "&tn=newsrss&sr=0&cl=2&rn=" & request("rows") & "&ct=0" Set xml = Server.CreateObject("Microsoft.XMLHTTP") xml.Open "GET",Cstr(RssUrl), False xml.Send Set xmlDom = server.createObject("microsoft.xmldom") xmlDom.async=False xmlDom.ValidateOnParse=false xmlDom.load(xml.responseXML) if xmlDom.ReadyState>2 Then set oItem=xmlDom.getElementsByTagName("item") If request("rows")<>"" Then rows=Cint(request("rows"))-1 Else rows=oItem.length-1 If rows>=oItem.length Then rows=oItem.length-1 for i=0 to rows strItem="" rss_title="" rss_link="" rss_description="" rss_author="" rss_pubdate="" rss_comments="" rss_category="" rss_guclass="" rss_enclosure="" rss_image="" rss_guid="" rss_other="" for j=0 to oItem(i).childNodes.length-1 select case Lcase(oItem(i).childNodes(j).nodeName) case "title" '标题 rss_title=clearHTMLCode(oItem(i).childNodes(j).text,"""|(</?div[^>]*>)") If txtlength<>"" Then rss_title=clearHTMLCode(Left(oItem(i).childNodes(0).text,txtlength),"""|(</?div[^>]*>)") Else rss_title=clearHTMLCode(oItem(i).childNodes(0).text,"""|(</?div[^>]*>)") rss_title=clearHTMLCode(rss_title,"<[^>]*>") case "link" '链接地址 rss_link=clearHTMLCode(oItem(i).childNodes(j).text,"</?div[^>]*>") case "description" '描述 rss_description=clearHTMLCode(oItem(i).childNodes(j).text,"</?div[^>]*>") case "author" '作者 rss_author=oItem(i).childNodes(j).text case "pubdate" '发布日期 rss_pubdate=oItem(i).childNodes(j).text case "comments" '注释 rss_comments=oItem(i).childNodes(j).text case "category" '分类 rss_category=oItem(i).childNodes(j).text case "guid" '全球唯一编号 rss_guid=oItem(i).childNodes(j).text case "enclosure" 'Flash或多媒体文件 If oItem(i).childNodes(j).GetAttribute("type")="application/x-shockwave-flash" Then rss_enclosure=oItem(i).childNodes(j).GetAttribute("url") case "image" '分类 rss_image=oItem(i).childNodes(j).text case else rss_other=rss_other & " " & oItem(i).childNodes(j).text end select next strItem="<div class=LogBrief><div class=rss_title>原文阅读:<a class=rss_link href=" & rss_link & " target=_blank>" & rss_title & "</a></div>" If isShowContent=1 Then strItem=strItem & "<div class=rss_description>" & Replace(rss_description,"""","'") & "</div><div class=rss_comments>" & rss_comments & "</div><div class='rss_other'>" & rss_other & "</div>" 'If rss_enclosure<>"" Then strItem=strItem & "<div class=rss_enclosure><embed width=100% height=100% src=" & rss_enclosure & "></embed></div>" If rss_enclosure<>"" Then strItem=strItem & "<div class=rss_enclosure><object classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,19,0 width=500 height=500><param name=movie value=" & rss_enclosure & "><param name=quality value=high><embed src=" & rss_enclosure & " quality=high pluginspage=http://www.macromedia.com/go/getflashplayer type=application/x-shockwave-flash width=100% height=100% ></embed></object></div>" If rss_image<>"" Then strItem=strItem & "<div class=rss_image>" & rss_image & "</div>" If rss_category<>"" Then strItem=strItem & "<div class=rss_category>分类:" & rss_category & "</div>" strItem=strItem & "<div class=rss_author>发布者:" & rss_author & "</div><div class=rss_pubdate>发布日期:" & rss_pubdate & "</div><div class=rss_guid>" & rss_guid & "</div>" End If strItem="<div class=rss_content>"& Replace(Replace(Replace(Replace(lcase(strItem),chr(34),""),vblf,""),"[img]","<img src="),"[/img]",">") & "</div><div class=rss_line></div></div>" %> <% sql="select Top 1 * from AS_Log Where Log_Title=""" & rss_title & """ And Log_Author=""" & rss_author & """ And news_ahome=""" & rss_link & """" Rs.Open sql,ConnSite,1,3 If Rs.Eof Then Rs.AddNew IF LogClass_ID<>"" Then LogClass_ID=Clng(LogClass_ID) Else LogClass_ID=1 '日志所属栏目分类 rs("Log_TStyle")="Log_TColor1 Log_TSizeS" rs("Log_Weather")="None|不详" rs("Log_Mood")="Glad|开心" rs("Log_From")=strRssTitle rs("Log_IsOpen")="1" rs("Log_Tag")=rss_category rs("Log_IsBest")="0" rs("Log_IsTop")="0" rs("Log_IsHot")="0" rs("Log_IsComment")="1" rs("Log_IsPost")="1" rs("Log_HtmlName")=replace(replace(replace(now(),"-",""),":","")," ","")&"-"&RandomString(5)&".html" rs("Log_Brief")=strItem rs("Log_Content")=strItem &"<br>"&rss_image&"<br>"&comments rs("Log_ClassID")=LogClassID rs("idRss")=LogClass_ID If rss_title="" Or rss_title=Empty Then rss_title="无题" rs("Log_Title")=rss_title rs("Log_Author")=rss_author rs("news_ahome")=rss_link Rs.Update '写入[AS_Tag]表 Tag = rss_category If Tag <> "" Then aTag = Split(Tag,",") If Instr(Tag,";") Then aTag=Split(Tag,";") '有些标签是以；号隔开的这里也有判断一下 For ii=0 To UBound(aTag) '--有些分类标签以“-”分开父子标签， 里遇到这种情况只取父标签存入AS_Tag表---------- aTagItem=aTag(ii) aTagItem=clearHTMLCode(aTagItem,"\d+") '清除数字分类 If aTagItem<>"" Then Tagsplit=0 Tagsplit=Instr(aTagItem,"-") If Tagsplit>1 Then aTagItem=left(aTagItem,Tagsplit-1) '--------------------------- Set Rs_T = Server.CreateObject("ADODB.Recordset") Sql_T = "Select Tag_Name From [AS_Tag] Where Tag_Name='"&Trim(aTagItem)&"'" Rs_T.Open Sql_T,ConnSite,1,3 If Rs_T.Eof And Rs_T.Bof Then Rs_T.AddNew Rs_T("Tag_Name") = aTagItem Rs_T.Update End If Rs_T.Close : Set Rs_T = Nothing End If Next End If '-生成静态页面-------------------- If LogClass_LogHtml="1" Then Log_ID=rs("Log_ID") '获取日志编号 Call ASCore.CreateLogFile(Log_ID) End If 'Response.Write(strItem) End If Rs.Close Response.Flush() next end if set Rs=Nothing Set xmlDom=Nothing Set xml = Nothing If LogClass_LogHtml="1" <> "0" Then Call ASCore.CreateLogClassIndex(LogClassID) '如果系统设置分栏页生成静态页的话则将分栏首页生成静态首页 If ASCore.BlogIndexHtml <> "0" Then Call ASCore.CreateBlogIndex() '如果系统设置首页生成静态页的话则将首页生成静态首页 'Response.Write("<div class=rss_title><b>" & strRssTitle & "</b>此项RSS资源抓取完毕</div>") End Function '-------------------------------------------------------------------------- |
最近读者：
