rss.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<!--#Include File="Inc/Conn.asp" -->
<!--#include file="Inc/Cls.Common.asp"-->
<%
'===========================================================
'Rss聚合参数定义
'ShowType：显示类型 1为文章 2为分类信息 3为店铺 4优惠券
'Content：是否显示具体内容 0为不显示 1为显示
'ChannelID：频道ID
'ClassID：分类ID
'Area：地区ID
'===========================================================
	Dim ShowType,Term,sCrLf,sRssHead,sRssEnd
	'参数定义
	Term = ""
	ShowType = WRMPS.CheckStr(Request.QueryString("ShowType"),1)
	If ShowType = "" Then ShowType = 2
    ChannelID = WRMPS.CheckStr(Request.QueryString("ChannelID"),1)
	If ChannelID = "" Then ChannelID = 0
    ClassID = WRMPS.CheckStr(Request.QueryString("ClassID"),1)
	If ClassID = "" Then ClassID = 0
	Content = WRMPS.CheckStr(Request.QueryString("Content"),1)
	If Content = "" Then Content = 1
	AreaID = WRMPS.CheckStr(Request.QueryString("AreaID"),1)
	If AreaID = "" Then AreaID = 0

    sCrLf = chr(13) & chr(10)
    UrlPath = WR_Setting(4)
	
	sRssHead = "<?xml version='1.0' encoding='gb2312'?>" & sCrLf
	sRssHead = sRssHead & "<rss version='2.0'>" & sCrLf
	sRssHead = sRssHead & "<channel>" & sCrLf
	sRssHead = sRssHead & "<website>"&WRMPS.LeachHTML(WRMPS.GetReplace(WR_Setting(0),"{$MyCity}",""))&"</website>" & sCrLf
	sRssHead = sRssHead & "<webMaster>"&WRMPS.LeachHTML(WRMPS.GetReplace(WR_Setting(0),"{$MyCity}",""))&"</webMaster>" & sCrLf
	sRssHead = sRssHead & "<updatePeri>15</updatePeri>" & sCrLf
	sRssHead = sRssHead & "<title>"&WRMPS.LeachHTML(WRMPS.GetReplace(WR_Setting(0),"{$MyCity}",""))&"</title>" & sCrLf
	sRssHead = sRssHead & "<description>"&WRMPS.LeachHTML(WR_Setting(7))&"</description>" & sCrLf
	sRssHead = sRssHead & "<link>" & WRMPS.LeachHTML(WR_Setting(4)) & "Rss.asp?ShowType="&ShowType&"</link>" & sCrLf
	sRssHead = sRssHead & "<logo>" & WRMPS.LeachHTML(WR_Setting(4)&WR_Setting(8)) & "</logo>" & sCrLf
	sRssHead = sRssHead & "<language>zh-cn</language>" & sCrLf
	sRssEnd = "</channel></rss>"

	Response.Charset = "gb2312"'"UTF-8"
	Response.ContentType = "text/xml"
    Response.write sRssHead
	Call XML()
    Response.write sRssEnd
	Call ClassEnd()

    Sub XML()
	  If ClassID > 0 Then Term = Term & " and WM_ClassID="&ClassID
	  Select Case Int(ShowType)
	    Case 1
		  If ChannelID > 0 Then Term = Term & " and WM_ChannelID="&ChannelID
		  SQL = "Select Top 50 WM_ID,WM_Title,WM_AddTime,WM_ChannelID,WM_ChannelDir,WM_ClassDir,WM_Content From WM_Article Where WM_IsDeleted=0 and WM_Passed=1"&Term&" Order By WM_ID Desc"
		Case 2
	      If AreaID > 0 Then Term = Term & " and WM_AreaID="&AreaID
		  SQL = "Select Top 50 WM_ID,WM_Title,WM_PostTime,WM_ChannelID,WM_ChannelDir,WM_ClassDir,WM_Content From WM_ClassAD Where WM_Key=1"&Term&" Order By WM_ID Desc"
		Case 3
	      If AreaID > 0 Then Term = Term & " and WM_AreaID="&AreaID
		  SQL = "Select Top 50 WM_ID,WM_Company,WM_CheckTime,WM_Intro From WM_Company Where WM_Key>0"&Term&" Order By WM_ID Desc"
		Case 4
	      If AreaID > 0 Then Term = Term & " and WM_AreaID="&AreaID
		  SQL = "Select Top 50 WM_ID,WM_Title,WM_Time,WM_ChannelID,WM_ChannelDir,WM_ClassDir,WM_Intro From WM_Coupon Where WM_Key>0"&Term&" Order By WM_ID Desc"
	  End Select
	  Call DBConnBegin()
	  Set Rs = Server.CreateObject("ADODB.Recordset")
	  Rs.Open SQL,Conn,1,1
	  Do While Not Rs.Eof
        Response.Write "<item>"&sCrLf
        Response.Write "<title>"&Replace(Replace(Replace(Replace(Replace(WRMPS.LeachHTML(Rs(1)),"&nbsp;"," "),"&","")," ",""),chr(10),""),vbcrlf,"")&"</title>"&sCrLf
	    Select Case Int(ShowType)
	      Case 1
		    Response.Write "<link>"&WRMPS.GetShowUrl(1,1,0,Rs(0),Rs(2),Rs(4)&Rs(5),Rs(3))&"</link>"&sCrLf
            If Content = 1 Then Response.Write "<description><![CDATA["&ReHTMLEncode(WRMPS.GotTopic(WRMPS.LeachHTML(Rs(6)),200,1))&"]]></description>"&sCrLf
	      Case 2
		    Response.Write "<link>"&WRMPS.GetShowUrl(1,1,0,Rs(0),Rs(2),Rs(4)&Rs(5),Rs(3))&"</link>"&sCrLf
            If Content = 1 Then Response.Write "<description><![CDATA["&ReHTMLEncode(WRMPS.GotTopic(WRMPS.LeachHTML(Rs(6)),200,1))&"]]></description>"&sCrLf
	      Case 3
		    Response.Write "<link>"&WRMPS.GetCompanyUrl(Rs(0))&"</link>"&sCrLf
            If Content = 1 Then Response.Write "<description><![CDATA["&ReHTMLEncode(WRMPS.GotTopic(WRMPS.LeachHTML(Rs(3)),200,1))&"]]></description>"&sCrLf
	      Case 4
		    Response.Write "<link>"&WRMPS.GetShowUrl(1,1,0,Rs(0),Rs(2),Rs(4)&Rs(5),Rs(3))&"</link>"&sCrLf
            If Content = 1 Then Response.Write "<description><![CDATA["&ReHTMLEncode(WRMPS.GotTopic(WRMPS.LeachHTML(Rs(6)),200,1))&"]]></description>"&sCrLf
	    End Select
		Response.Write "<pubDate>"&WRMPS.GetHTMLEncode(Rs(2))&"</pubDate>" &sCrLf
        Response.Write "</item>"&sCrLf
	  Rs.MoveNext
	  Loop
	  Rs.Close
	  Set Rs = Nothing	  
	  Call DBConnEnd()
	End Sub

	'**************************************************
	'函数名：ReHTMLEncode
	'作  用：将文本转化为有格式的HTML代码
	'参  数：reString--传入文本
	'返回值：转化后的代码
	'**************************************************
	Function ReHTMLEncode(reString)
	  Dim Str:Str=reString
	  If Not IsNull(Str) Then
		Str = Replace(Str, "&amp;" ,"&")
		Str = Replace(Str, "&gt;", ">")
		Str = Replace(Str, "&lt;", "<")
		Str = Replace(Str, "&nbsp;", CHR(32))
		Str = Replace(Str, "&nbsp;&nbsp;&nbsp;&nbsp;", CHR(9))
		Str = Replace(Str, "&#160;&#160;&#160;&#160;", CHR(9))
		Str = Replace(Str, "&quot;", CHR(34))
		Str = Replace(Str, "&#39;", CHR(39))
		Str = Replace(Str, "", CHR(13))
		Str = Replace(Str, "<br>", CHR(10))
		Str = Replace(Str, "<br/>", CHR(10))
		ReHTMLEncode = Str
	  End If
	End Function

%>