Asp+Rss阅读器制作

　　<!--#include file="conn.asp"-->

　　<%

　　'******************************

　　'文件名：index.asp

　　'功 能：RSS阅读器显示页面

　　'日 期：2006-6-19

　　'编 程：Cloud.L

　　'******************************

　　Response.contentType="application/xml;charset=gb2312"

　　%>

　　<?xml version="1.0" encoding="gb2312"?>

　　<rss version="2.0">

　　<channel>

　　<rssname><%=SiteName%></rssname>

　　<author><%=Author%></author>

　　<mail><%=Mail%></mail>

　　<%

　　Sql="select top 20 * from [SIHRT_Rss] order by Rss_Date desc,Rss_ID desc"

　　Set Rs=Server.CreateObject("Adodb.Recordset")

　　Rs.open Sql,Conn,1,1

　　if Rs.eof and Rs.bof then

　　Response.Write "<listitems><nodata>无列表数据</nodata></listitems>"

　　else

　　Response.Write "<listitems>"

　　do while not Rs.eof

　　Rss_Cont=replace(Rs("Rss_Cont"),"<br>","")

　　%>

　　<item>

　　<rssid><%=Rs("Rss_ID")%></rssid>

　　<title><%=Rs("Rss_Title")%></title>

　　<postdate><%=Rs("Rss_Date")%></postdate>

　　<content><![CDATA[<%=Rss_Cont%>]]></content>

　　</item>

　　<%

　　Rs.movenext

　　loop

　　Response.Write "</listitems>"

　　end if

　　RsClose

　　Connclose

　　%>

　　</channel>

　　</rss>

　　<!--#include file="Const.asp"-->

　　<%Response.Buffer=True%>

　　<%

　　'******************************

　　'文件名：Conn.asp

　　'功 能：RSS阅读程序与数据库连接文件

　　'日 期：2006-6-18

　　'编 程：Cloud.L

　　'******************************

　　Dim ConnStr,Conn

　　'Create Connection

　　ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(DataPath)

　　Set Conn=Server.CreateObject("Adodb.Connection")

　　Conn.open ConnStr

　　'Close Rs

　　Sub RsClose

　　Rs.Close

　　Set Rs=nothing

　　End Sub

　　'Close Conn

　　Sub ConnClose

　　Conn.Close

　　Set Conn=nothing

　　End Sub

　　%>

　　<%

　　'******************************

　　'文件名：Const.asp

　　'功 能：定义RSS阅读程序常量

　　'日 期：2006-6-18

　　'编 程：Cloud.L

　　'******************************

　　Const DataPath="Data/RssData.mdb"

　　Const SiteName="SIHRT--RSS阅读器"

　　Const Author="Cloud.L"

　　Const Mail="[email protected]"

　　%>

　　<!--#include file="Conn.asp"-->

　　<link href="inc/style.css" rel="stylesheet" type="text/css">

　　<script language="JavaScript" src="inc/checkFunction.js"></script>

　　<%

　　'******************************

　　'文件名：Admin.asp

　　'功 能：数据添加管理文件

　　'日 期：2006-6-18

　　'编 程：Cloud.L

　　'******************************

　　Dim Wid,Rs,Sql

　　Wid=700

　　Select Case Request("menu")

　　Case ""

　　Main

　　Case "AddOk"

　　IsAdd=1

　　RsOk

　　Case "EditRs"

　　EditRs

　　Case "EditOk"

　　IsAdd=0

　　RsOk

　　Case "DelOk"

　　conn.execute("delete from [SIHRT_Rss] where Rss_ID="&Request("ID"))

　　Response.Redirect("Admin.asp")

　　Case "DelAll"

　　if Request("CID")="" then

　　Response.write "<script>alertMsg('您没有选择删除项');</script>"

　　end if

　　for each DelItem in Request("CID")

　　conn.execute("delete from [SIHRT_Rss] where Rss_ID="&DelItem)

　　next

　　Response.Redirect("Admin.asp")

　　End Select

　　Sub Main

　　'This is main sub

　　Sql="select * from [SIHRT_Rss] order by Rss_ID"

　　Set Rs=Server.CreateObject("Adodb.Recordset")

　　Rs.open Sql,Conn,1,1

　　%>

　　<form action="?menu=DelAll" method="post" name="ListForm">

　　<table border="0" cellpadding="2" cellspacing="1" align="center" width="<%=Wid%>" class="tb_bg">

　　<tr class="tr_tt">

　　<td colspan="5" align="center">--==== RSS数据管理 ====--</td>

　　</tr>

　　<tr class="tr_tt2">

　　<td width="5%" align="center" title="全选数据项"><input type="checkbox" name="SelectAll" onclick="checkAll(this)" class="checkbox"></td>

　　<td width="5%" align="center">ID</td>

　　<td width="20%" align="center">主题</td>

　　<td width="60%" align="center">内容</td>

　　<td width="10%" align="center">操作</td>

　　</tr>

　　<%

　　if Rs.eof and Rs.eof then

　　response.write "<tr class=""tr_bg""><td colspan=""5"" align=""center""><font color=red>无列表项数据,请添加记录</font></td>"

　　else

　　do while not Rs.eof

　　%>

　　<tr class="tr_bg" onmouseover="this.className='tr_over'" onmouseout="this.className='tr_out'">

　　<td align="center"><input type="checkbox" name="CID" class="checkbox" value="<%=Rs("Rss_ID")%>"></td>

　　<td align="center"><%=Rs("Rss_ID")%></td>

　　<td><%=Rs("Rss_Title")%></td>

　　<td>

　　<%

　　Rss_cont=replace(Rs("Rss_Cont"),"<br>","")

　　if len(Rss_Cont)>32 then

　　Response.write left(Rss_Cont,32)&"..."

　　else

　　Response.write Rss_Cont

　　end if

　　%>

　　</td>

　　<td align="center">

　　<a href="?menu=EditRs&ID=<%=Rs("Rss_ID")%>" title="编辑该记录">编辑</a>  <a href="?menu=DelOk&ID=<%=Rs("Rss_ID")%>" title="删除该记录" onclick="checkConfirm('您确定删除该记录?')">删除</a>

　　</td>

　　</tr>

　　<%

　　Rs.MoveNext

　　loop

　　end if

　　RsClose 'Close Recordset

　　%>

　　<tr class="tr_bg">

　　<td colspan="5"><input type="submit" name="DelAllItems" value="删除所选" class="button"></td>

　　</tr>

　　</table>

　　</form>

　　<form action="?menu=AddOk" method="post" name="AddForm" style="margin-top:4px;">

　　<table border="0" cellpadding="2" cellspacing="1" width="<%=Wid%>" align="center" class="tb_bg">

　　<tr class="tr_tt">

　　<td colspan="2" align="center">--==== 添加记录 ====--</td>

　　</tr>

　　<tr class="tr_bg">

　　<td width="20%">记录主题</td>

　　<td width="80%"><input type="text" name="Rss_Title" size="24" maxlength="20"></td>

　　</tr>

　　<tr class="tr_bg">

　　<td valign="top" style="padding-top:4px;">记录内容</td>

　　<td><textarea name="Rss_Cont" cols="40" rows="6"></textarea></td>

　　</tr>

　　<tr class="tr_bg">

　　<td colspan="2"><input type="submit" name="SRss" value="添加记录" class="button">  <input type="reset" name="RRss" value="重新添写" class="button"></td>

　　</tr>

　　</table>

　　</form>

　　<%

　　End Sub

　　Sub RsOk

　　Rss_Title=Trim(Request.Form("Rss_Title"))

　　errorchar=array("@","#",".","|","%","&","+",";","<",">")

　　for i=0 to ubound(errorchar)

　　if instr(Rss_Title,errorchar(i))>0 then

　　Response.Write "<script>alertMsg('主题中不能包含特殊字符');</script>"

　　exit Sub

　　end if

　　next

　　Rss_Cont=Request.Form("Rss_Cont")

　　if Rss_Title<>"" or Rss_Cont<>"" then

　　Sql="Select * from [SIHRT_Rss]"

　　Set Rs=Server.CreateObject("Adodb.Recordset")

　　Rs.open Sql,Conn,1,3

　　if IsAdd=1 then

　　Rs.AddNew

　　end if

　　Rs("Rss_Title")=Rss_Title

　　Rs("Rss_Cont")=Rss_Cont

　　Rs.Update

　　Response.Redirect "Admin.asp"

　　RsClose

　　else

　　Response.Write "<script>alertMsg('请添写完整记录信息')</script>"

　　end if

　　End Sub

　　Sub EditRs

　　Sql="select * from [SIHRT_Rss] where Rss_ID="&Request("ID")

　　Set Rs=Server.CreateObject("Adodb.Recordset")

　　Rs.open Sql,Conn,1,1

　　%>

　　<form action="?menu=EditOk" method="post" name="AddForm" style="margin-top:4px;">

　　<table border="0" cellpadding="2" cellspacing="1" width="<%=Wid%>" align="center" class="tb_bg">

　　<tr class="tr_tt">

　　<td colspan="2" align="center">--==== 编辑记录 ====--</td>

　　</tr>

　　<tr class="tr_bg">

　　<td width="20%">记录主题</td>

　　<td width="80%"><input type="text" name="Rss_Title" size="24" maxlength="20" value="<%=Rs("Rss_Title")%>"></td>

　　</tr>

　　<tr class="tr_bg">

　　<td valign="top" style="padding-top:4px;">记录内容</td>

　　<td><textarea name="Rss_Cont" cols="40" rows="6"><%=replace(Rs("Rss_Cont"),"<br>",chr(10))%></textarea></td>

　　</tr>

　　<tr class="tr_bg">

　　<td colspan="2">

　　<input type="submit" name="SRss" value="修改记录" class="button">

　　<input type="reset" name="RRss" value="重新添写" class="button">

　　<input type="button" name="GoBack" value="返回上页" class="button" onclick="history.back();">

　　</td>

　　</tr>

　　</table>

　　</form>

　　<%

　　End Sub

　　ConnClose

　　%>