复件 news_class.asp

这是我根据动网新闻核心自行设计的校园新闻系统

					orderid=rs("orderid")
					pic=rs("pic")
					categorytype=rs("categorytype")
					categoryid=rs("categoryid")
					DateAndTime=rs("dateandtime")
					hits=rs("hits")
					Writer=rs("writer")
					TitleStyle=rs("titlestyle")
					titleurl=rs("titleurl")
					categoryName=rs("categoryname")
					source=rs("source")
					Style=tcode
					Style=templatecode(Style)
					style=Replace(style,chr(13),"")
					style=Replace(style,Chr(10),"")
					style=Replace(style,"""","\"&""""&"")		
					Response.Write style
					i=i+1
					rs.MoveNext
				End If
				Response.Write "</td>"
			Next
			Response.Write "</tr>"
		loop
		rs.Close
		Set rs = Nothing
		Response.Write "</table>"
		'显示统计数据以及跳转菜单
		Response.Write "<BR>"
		Response.Write "<table width=100% style='border:0px'; cellpadding=0 cellspacing=0 class='table'>"
		Response.Write "<tr>"
		Response.Write "<td class='td'>"
		showpage totalcount,pagecount,nowpage,"?category="&category&""
		Response.Write "</td>"
		Response.Write "</tr>"
		Response.Write "</table>"
	End Function
'# ----------------------------------------------------------------------------
'# 函数：NewsList
'# 描述：新闻列表
'# 参数： Categoryid-类别,ntype-类别,Num-数量,tode-模板
'# 返回：列表HTML
'# 作者：雷の龙
'# 日期：2004-4-19
'#-----------------------------------------------------------------------------
	Public Function NewsList(Categoryid,ntype,rows,cols,tcode) 
		Dim rs
		Dim Style
		Dim sql
		Dim Num
		Num=CInt(rows)*CInt(cols)
		sql="select top "&cint(Num)&" *,(select categoryname from category where categoryid=news.categoryid and categoryType=news.categorytype) as categoryname from [news] where categorytype='"&CategoryType&"'"
		If Categoryid<>"-1" And categoryid<>"" Then
			sql=sql&" and left(categoryid,"&len(categoryid)&")='"&categoryid&"'"
		End If

		'判断是否是推荐新闻列表
		If InStr(ntype,"commend")<>0 Then
			sql=sql&" and instr(attribute,'commend')<>0"
		End If

		'判断是否图片新闻
		If InStr(ntype,"picnews")<>0 Then
			sql=sql&" and instr(attribute,'picnews')<>0"
		End If

		'判断排序方式
		If InStr(ntype,"hot")<>0 Then
			sql=sql&" order by hits desc"
		else
			sql=sql&" order by orderid desc"
		End If
		Dim i
		i=0
		Set rs=Conn.execute(sql)
		Response.Write "<table width=100% border=0 cellpadding=0 cellspacing=0>"
		Do While not rs.eof And i<cint(num)
			Response.Write "<tr>"
			For a= 1 To cols 
				Response.Write "<td class=td>"
				If Not rs.eof And i<CInt(num) Then
					Id=rs("id")
					Title=rs("title")
					content=rs("content")
					keyword=rs("keyword")
					attribute=rs("attribute")
					text=rs("text")
					username=rs("username")
					dateandtime=rs("dateandtime")
					template=rs("template")
					pass=rs("pass")
					orderid=rs("orderid")
					pic=rs("pic")
					categorytype=rs("categorytype")
					categoryid=rs("categoryid")
					DateAndTime=rs("dateandtime")
					hits=rs("hits")
					Writer=rs("writer")
					TitleStyle=rs("titlestyle")
					titleurl=rs("titleurl")
					categoryName=rs("categoryname")
					source=rs("source")
					Style=tcode
					Style=templatecode(Style)
					style=Replace(style,chr(13),"")
					style=Replace(style,Chr(10),"")
					style=Replace(style,"""","\"&""""&"")		
					Response.Write style
					i=i+1
					rs.MoveNext
				End If
				Response.Write "</td>"
			Next
			Response.Write "</tr>"
		loop
		rs.Close
		Set rs = Nothing
		Response.Write "</table>"
	End Function
'# ----------------------------------------------------------------------------
'# 函数：ReLenText()
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
	Private Function ReLenText(text,length)
		If IsNull(text) Then exit function
		If length<>"" And Len(text)>CLng(length) Then
			text=Left(text,length)&"..."
		End If
		ReLenText=text
	End Function

'# ----------------------------------------------------------------------------
'# 函数：OpenUrl()
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
	Private Function OpenUrl(utext,uurl,utype)
		Dim u
		Select Case utype
		  Case "jsopen"
			u="<a href='#' onclick="&""""&"window.open('"&uurl&"','','width="&cWindowWidth&",Height="&cWindowHeight&"');"&""""&">"&utext&"</a>"
		  Case Else
			u="<a href='"&uurl&"' target='"&utype&"'>"&utext&"</a>"
		End Select
		OpenUrl=u
	End Function
'# ----------------------------------------------------------------------------
'# 函数：templatecode
'# 描述：模板处理
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004-4-19
'#-----------------------------------------------------------------------------
	Private Function TemplateCode(tcode) 
		Dim re
		Dim lb
		Dim t
		Dim re_1
		Set re=new RegExp
		Set re_1=new RegExp
		re.IgnoreCase =True
		re_1.IgnoreCase =True
		re.Global=True
		re_1.Global=True
		t=tcode
		'找出所有系统标识
		'匹配datatag的data项
		re.Pattern="<lb:Datatag[^<>]* (Data="&""""&"(\w*)"&""""&"){1}[^<>]*></lb:Datatag>"
		Dim matches,mat,subm
		Dim matches_1,mat_1,subm_1
		Dim length
		
		Set matches=re.Execute(t)
		For Each mat In matches
			'匹配datatag中的length属性
			re_1.pattern=" (length=\"&""""&"(\w*)\"&""""&")"
			Set matches_1=re_1.Execute(mat.value)
			For Each mat_1 In matches_1
				If mat_1.submatches(1)<>"" Then
					length=mat_1.submatches(1)
				End If
			Next
			subm=LCase(mat.submatches(1))
			Select Case subm
			  Case "title"
				t=Replace(t,mat.value,"{title}")
				'判断是否有连接到其他地址
				If titleurl="" Or titleurl="http://" Then
					t=Replace(t,"{title}",OpenUrl("{title}",url&"news_show.asp?id="&Id&"",cOpenWindow))
				Else
					t=Replace(t,"{title}",OpenUrl("{title}",TitleUrl,"_blank"))
				End If

				t=Replace(t,"{title}","<font color='"&split(Titlestyle,",")(0)&"'>{title}</font>")
				
				'判断标题是否需要加粗
				If InStr(LCase(Titlestyle),"b")<>0 Then
					t=Replace(t,"{title}","<b>{title}</b>")
				End If
				
				'判断标题是否需要倾斜
				If InStr(LCase(Titlestyle),"i") Then
					t=Replace(t,"{title}","<i>{title}</i>")
				End If
				t=Replace(t,"{title}",ReLenText(ReturnData("title"),length))
			  Case Else
				t=Replace(t,mat.value,ReLenText(ReturnData(subm),length))
			End Select
		Next

		re.Pattern="<lb:showtag[^<>]* (?:condition="&""""&"(\w+) (\+|\-|\*|\/|(?:instr)|(?:datediff)) (\w+) (=|>|<|(?:<>)) (\d)"&""""&"){1}[^<>]*></lb:showtag>"
		Set matches=re.Execute(t)
'		If re.test(t) Then
'			response.write "aaaa"
'		else
'			Response.Write "bbb"
'		End If
		Dim smat0,smat1,smat2
		Dim rtype,value

		For Each mat In matches

			'匹配showtag中的type属性
			re_1.pattern=" (type="&""""&"((?:text)|(?:image))"&""""&")"
			Set matches_1=re_1.Execute(mat.value)
			For Each mat_1 In matches_1
				If mat_1.submatches(1)<>"" Then
					rtype=mat_1.submatches(1)
				End If
			Next

			'匹配showtag中的value属性
			re_1.pattern=" (value="&""""&"(.*)"&""""&")"
			Set matches_1=re_1.Execute(mat.value)
			For Each mat_1 In matches_1
				If mat_1.submatches(1)<>"" Then
					value=mat_1.submatches(1)
				End If
			Next

			sdata=mat.submatches(0)
			soperator=mat.submatches(1)
			sobject=mat.submatches(2)
			sor=mat.submatches(3)
			sresult=mat.submatches(4)
			Select Case soperator
			  Case "instr"
				If ReturnResult(CBool(InStr(ReturnData(sdata),sobject)),sor,CBool(CInt(sresult))) Then
					t=re.replace(t,ReturnType(rtype,value))
				else
					t=re.Replace(t,"")
				End If
			  Case "datediff"
				If LCase(sobject)="now" Then
					sobject=Now()
				End If
				If ReturnResult(DateDiff("d",CDate(ReturnDate(sdata)),CDate(sobject)),sor,CInt(sresult)) Then
					t=re.replace(t,ReturnType(rtype,value))
				else
					t=re.Replace(t,"")
				End If
			  Case "+"
'				Response.Write CStr(ReturnResult(CLng(ReturnData(sdata))+CLng(sobject),sor,CLng(sresult)))
'				Response.Write CLng(ReturnData(sdata))+CLng(sobject)
'				Response.Write sor
'				Response.Write CLng(sresult)
'				Response.Write rtype
'				Response.Write value
'				Response.Write ReturnType(rtype,value)
				
				If ReturnResult(CLng(ReturnData(sdata))+CLng(sobject),sor,CLng(sresult)) Then
					t=replace(t,mat.value,ReturnType(rtype,value))
				else
					t=Replace(t,mat.value,"")
				End If
			  Case "-"
				If ReturnResult(CLng(ReturnData(sdata))-CLng(sobject),sor,CLng(sresult)) Then
					t=replace(t,mat.value,ReturnType(rtype,value))
				else
					t=Replace(t,mat.value,"")
				End If
			  Case "*"
				If ReturnResult(CLng(ReturnData(sdata))*CLng(sobject),sor,CLng(sresult)) Then
					t=replace(t,mat.value,ReturnType(rtype,value))
				else
					t=Replace(t,mat.value,"")
				End If
			  Case "/"
				If ReturnResult(CLng(ReturnData(sdata))/CLng(sobject),sor,CLng(sresult)) Then
					t=replace(t,mat.value,ReturnType(rtype,value))
				else
					t=Replace(t,mat.value,"")
				End If
			  Case Else
			End Select
		Next
		Set mat=Nothing
		Set mat_1=Nothing
		Set matches=Nothing
		Set matches_1=Nothing
		Set re=Nothing
		Set re_1=Nothing
		TemplateCode=t
	End Function
'# ----------------------------------------------------------------------------
'# 函数：ReturnResult
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
	Private Function ReturnResult(r1,op,r2)
		returnResult=false
		r1=CLng(r1)
		r2=CLng(r2)
		Select Case op
		  Case "="
			If r1=r2 Then
				ReturnResult=true
			Else
				ReturnResult=false
			End If
		  Case ">"
			If r1>r2 Then
				ReturnResult=true
			Else
				ReturnResult=false
			End If
		  Case "<"
			If r1<r2 Then
				ReturnResult=true
			Else
				ReturnResult=false
			End If
		  Case "<>"
			If r1<>r2 Then
				ReturnResult=true
			Else
				ReturnResult=false
			End If
		  Case Else
		End Select
	End Function
'# ----------------------------------------------------------------------------
'# 函数：ReturnType
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
	Private Function ReturnType(rtype,rvalue)
		Select Case rtype
		  Case "text"
			ReturnType=rvalue
		  Case "image"
			ReturnType="<img src='"&rvalue&"' border=0>"
		  Case Else
		End Select
	End Function
'# ----------------------------------------------------------------------------
'# 函数：ReturnData
'# 描述：返回数据库内容
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
	Public Function  ReturnData(text)
			Select Case text
			  Case "title"
				ReturnData=TiTle
			  Case "categoryid"
				ReturnData=CategoryID
			  Case "categoryname"
				ReturnData=CategoryName
			  Case "id"
				ReturnData=ID
			  Case "titlestyle"
				ReturnData=TitleStyle
			  Case "titleurl"
				ReturnData=TitleUrl
			  Case "content"
				ReturnData=Content
			  Case "writer"
				ReturnData=Writer
			  Case "source"
				ReturnData=Source
			  Case "keyword"
				ReturnData=KeyWord
			  Case "attribute"
				ReturnData=Attribute
			  Case "text"
				ReturnData=Text
			  Case "username"
				ReturnData=UserName
			  Case "dateandtime"
				ReturnData=DateAndTime
			  Case "year"
				ReturnData=CStr(Year(dateandtime))
			  Case "month"
				ReturnData=CStr(month(dateandtime))
			  Case "day"
				ReturnData=CStr(day(dateandtime))
			  Case "hour"
				ReturnData=CStr(hour(dateandtime))
			  Case "minute"
				ReturnData=CStr(minute(dateandtime))
			  Case "second"
				ReturnData=CStr(second(dateandtime))
			  Case "template"
				ReturnData=cstr(Template)
			  Case "pass"
				ReturnData=cstr(pass)
			  Case "hits"
				ReturnData=cstr(Hits)
			  Case "orderid"
				ReturnData=cstr(orderid)
			  Case "pic"
				ReturnData=Pic
			  Case "categorytype"
				ReturnData=CategoryType
			  Case Else
			End Select
	End Function
End Class

%>