📄 news_class.asp
字号:
If Isnull(Rs(0)) Or Rs(0)="" Then
Id=1
Else
Id=Rs(0)+1
End If
Set Rs=Server.Createobject("Adodb.Recordset")
Sql="Select * From [News]"
Rs.Open Sql,Actionconn,3,2
Rs.Addnew
Rs("Id")=Id
Rs("Title")=Title
Rs("Categoryid")=Categoryid
Rs("Titlestyle")=Titlestyle
Rs("Titleurl")=Titleurl
Rs("Content")=Content
Rs("Writer")=Writer
Rs("Source")=Source
Rs("Keyword")=Keyword
Rs("Attribute")=Attribute
Rs("Text")=Text
Rs("Username")=Username
Rs("Dateandtime")=Dateandtime
Rs("Template")=Template
Rs("Pass")=Pass
Rs("Hits")=Hits
Rs("Orderid")=Id
Rs("Categorytype")=Categorytype
Rs("pic")=Pic
Rs("ordertime")=DateAndTime
Rs.Update
Rs.Close
Set Rs=Nothing
End Function
'# ----------------------------------------------------------------------------
'# 函数：Modify
'# 描述：修改新闻内容
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004-04-09
'#-----------------------------------------------------------------------------
Private Function Modify()
Dim Rs,Sql
Set Rs=Server.Createobject("Adodb.Recordset")
Sql="Select * From [News] Where Id="&Id
Rs.Open Sql,Actionconn,3,2
Rs("Title")=Title
Rs("Categoryid")=Categoryid
Rs("Titlestyle")=Titlestyle
Rs("Titleurl")=Titleurl
Rs("Content")=Content
Rs("Writer")=Writer
Rs("Source")=Source
Rs("Keyword")=Keyword
Rs("Attribute")=Attribute
Rs("Text")=Text
Rs("Template")=Template
Rs("Pass")=Pass
Rs("pic")=Pic
Rs.Update
Rs.Close
Set Rs=Nothing
If Err Then
Call ShowError("新闻修改失败")
Else
Call ShowSuccess("新闻修改成功","?action=list")
End If
End Function
'# ----------------------------------------------------------------------------
'# 函数：Delete
'# 描述：删除新闻
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004-4-12
'#-----------------------------------------------------------------------------
Private Function Delete()
Dim Sql
If Id="-1" Then
Sql="Delete * From News Where Categorytype='"&CategoryType&"'"
ElseIf Id<>"" And Id<>"0" Then
Sql="Delete * From News Where Id="&Id
Else
Sql="Delete * From News where Id in ("&idd&")"
End If
Actionconn.Execute(Sql)
If Err Then
Call ShowError("新闻删除失败")
Else
Call ShowSuccess("新闻删除成功","?action=list")
End If
End Function
'# ----------------------------------------------------------------------------
'# 函数：取得单个新闻的属性
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004-4-12
'#-----------------------------------------------------------------------------
Public Function Getnews(Gid)
Dim Rs
Set Rs=Actionconn.Execute("Select * From news Where Id="&Gid)
Id=Rs("Id")
Title=Rs("Title")
Categoryid=Rs("Categoryid")
Titlestyle=Rs("Titlestyle")
Titleurl=Rs("Titleurl")
Content=Rs("Content")
Writer=Rs("Writer")
Source=Rs("Source")
Keyword=Rs("Keyword")
Attribute=Rs("Attribute")
Text=Rs("Text")
Username=Rs("Username")
Dateandtime=Rs("Dateandtime")
Template=Rs("Template")
Pass=Rs("Pass")
Orderid=Rs("Orderid")
Hits=Rs("Hits")
Categorytype=Rs("Categorytype")
Pic=Rs("pic")
Rs.Close
Set Rs=Nothing
End Function
'# ----------------------------------------------------------------------------
'# 函数：News_Show(nid)
'# 描述：
'# 参数： nid-新闻id,ncode-新闻显示用模板
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Public Function News_Show(nid,ncode)
GetNews(nid)
ActionConn.execute("update news set hits=hits+1 where id="&nid)
Response.Write TemplateCode(ncode)
End Function
'# ----------------------------------------------------------------------------
'# 函数：MoreList(Categoryid-类别,ntype-类别,Num-数量,tode-模板)
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Public Function MoreList(cid,ntype,rows,cols,tcode)
Dim rs
Dim Style
Dim sql
Dim Num
Num=CInt(rows)*CInt(cols)
sql="select *,(select categoryname from category where categoryid=news.categoryid and categoryType=news.categorytype) as categoryname,(select id from category where categoryid=news.categoryid and categoryType=news.categorytype) as ctid from [news] where categorytype='"&CategoryType&"' and pass<>0"
If cid<>"-1" And cid<>"" Then
sql=sql&" and left(categoryid,"&len(cid)&")='"&cid&"'"
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 cbool(instr(attribute,'top')) asc, hits desc"
else
sql=sql&" order by cbool(instr(attribute,'top')) asc, orderid desc"
End If
Dim i
i=0
Set rs=Server.CreateObject("adodb.recordset")
rs.open sql,ActionConn,3,1
Response.Write "<table width=100% border=0 cellpadding=0 cellspacing=0>"
Dim totalcount,count,pagecount,nowpage,a
totalcount=rs.recordcount
'***********************************分页
count=Num
if count<=0 then
count=Num
end if
if not rs.eof then
rs.pagesize=count
pagecount=rs.pagecount
if request.querystring("page")="" then
nowpage=1
else
nowpage=int(request.querystring("page"))
end if
if nowpage>=rs.pagecount then
nowpage=rs.pagecount
elseif nowpage<=1 then
nowpage=1
end if
rs.absolutepage=nowpage
else
pagecount=1
nowpage=1
end if
a=1
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")
ctid=rs("ctid")
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,"?categoryid="&ctid&""
Response.Write "</td>"
Response.Write "</tr>"
Response.Write "</table>"
End Function
'# ----------------------------------------------------------------------------
'# 函数：NewsList
'# 描述：新闻列表
'# 参数： Categoryid-类别,ntype-类别,Num-数量,tode-模板
'# 返回：列表HTML
'# 作者：雷の龙
'# 日期：2004-4-19
'#-----------------------------------------------------------------------------
Public Function NewsList(Cid,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,(select id from category where categoryid=news.categoryid and categoryType=news.categorytype) as ctid from [news] where categorytype='"&CategoryType&"' and pass<>0"
If cid<>"-1" And cid<>"" Then
sql=sql&" and left(categoryid,"&len(cid)&")='"&cid&"'"
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 cbool(instr(attribute,'top')) asc, hits desc"
else
sql=sql&" order by cbool(instr(attribute,'top')) asc, 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")
CtID=rs("ctid")
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 CLng(GetLen(text))>CLng(length) Then
text=LeftStr(text,length)&"..."
End If
ReLenText=text
End Function
'# ----------------------------------------------------------------------------
'# 函数：OpenUrl()
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Private Function OpenUrl(utext,uurl,utype)
Dim u
If uurl<>"false" Then
Select Case utype
Case "jsopen"
u="<a href='#' title='{alltitle}' onclick="&""""&"window.open('"&uurl&"','','width="&cWindowWidth&",Height="&cWindowHeight&"');"&""""&">"&utext&"</a>"
Case Else
u="<a href='"&uurl&"' title='{alltitle}' target='"&utype&"'>"&utext&"</a>"
End Select
OpenUrl=u
Else
OpenUrl=utext
End if
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -