system.asp

大榕树网络文章管理系统

    response.write strsearch
end sub
'==============================================================
'功能：本站统计
'参数：无
'==============================================================
sub webcount()
dim sqlcount,rscount
set rscount=server.createobject("ADODB.Recordset")
sqlcount="select count(*) from article where passed=true"
rscount.open sqlcount,conn,1,1
    response.write"<li>文章共有&nbsp;"&rscount(0)&"&nbsp;篇</li>" 
rscount.close
sqlcount="select count(*) from comment"
rscount.open sqlcount,conn,1,1
     response.write"<li>文章评论&nbsp;"&rscount(0)&"&nbsp;个</li>" 
rscount.close
sqlcount="select count(*) from  userbook where passed=true"
rscount.open sqlcount,conn,1,1
     response.write"<li>论坛主题&nbsp;"&rscount(0)&"&nbsp;个</li>"
rscount.close
sqlcount="select count(*) from reuserbook"
rscount.open sqlcount,conn,1,1
     response.write"<li>论坛回贴&nbsp;"&rscount(0)&"&nbsp;条</li>"
rscount.close 
sqlcount="select count(*) from Reguser"
rscount.open sqlcount,conn,1,1
    response.write"<li>注册用户&nbsp;"&rscount(0)&"&nbsp;人</li>"
rscount.close 
sqlcount="select count(*) from Reguser where userlevel>1"
rscount.open sqlcount,conn,1,1
     response.write"<li>其中会员&nbsp;"&rscount(0)&"&nbsp;人</li>"
rscount.close 
sqlcount="select sum(hits) from article"
rscount.open sqlcount,conn,1,1
    response.write"<li>文章阅读&nbsp;"&rscount(0)&"&nbsp;人次</li>"
rscount.close
    response.write"<li>当前在线：共&nbsp;<font color='#FF6600'>"&application("online")&"</font>&nbsp;人</li>"
set rscount=nothing                
end sub
'==============================================================
'功能：个人文集
'参数：i---显示个数
'==============================================================
sub showuserlist(i)
dim rsuserlist,j
set rsuserlist=server.createobject("ADODB.Recordset")
rsuserlist.open"select usid,articles from RegUser where articles>0 order by articles desc",conn,1,1
if rsuserlist.eof or rsuserlist.bof then
response.write"<li>还没有文集</li>"
else
for j=1 to i
if rsuserlist.eof then
exit for
end if
response.write"<li><a href='UserArtlist.asp?usid="&rsuserlist("usid")&"' target='_blank'>"&rsuserlist("usid")&"</a>&nbsp;&nbsp;共"&rsuserlist("articles")&"篇</li>"
rsuserlist.movenext
next
end if
response.write"<li class='userartlist'><a href='UserArt.asp' target='_blank'>更多文集…</a></li>"
rsuserlist.close
set rsuserlist=nothing
end sub
'==============================================================
'功能：用户爬行榜
'参数：i---显示个数
'==============================================================
sub showusergo(i)
dim rs,j
set rs=server.createobject("ADODB.Recordset")
    rs.open"select loginname,userlevel,visits from UserLogin order by visits desc",conn,1,1
if rs.eof or rs.bof then
   response.write"<li>还没有用户登录</li>"
else
   for j=1 to i
       if rs.eof then
          exit for
       end if
           response.write"<li><img src='images/user.gif'>&nbsp;"&rs("loginname")&"&nbsp;&nbsp;访问"&rs("visits")&"次</li>"
   rs.movenext
   next
end if
rs.close
set rs=nothing
end sub
'===============================================================
'功能：最新公告
'参数：i---显示条数
'===============================================================
sub showannounce(i)
dim rsann,h
set rsann=server.createobject("ADODB.Recordset")
rsann.open"select * from announce where isnew=true order by announceid desc",conn,1,1
if rsann.eof and rsann.bof then
response.write"<li>暂时没有公告</li>"
rsann.close
set rsann=nothing
else
for h=1 to i
if rsann.eof then
exit for
end if
response.write"<li>◇&nbsp;"&rsann("content")&"</li>"
response.write"<div align='right'>"&rsann("author")&"<br>"&rsann("addtime")&"</div>"
rsann.movenext
next
rsann.close
set rsann=nothing
end if
end sub
'================================================================================
'功能：显示最新图文
'参数：t---显示方式 1：显示大类 2：显示小类，3：显示其它；i---文章个数；j---标题长度；w---图片高度；h---图片宽度）
'================================================================================
sub defaultpicshow(t,i,j,w,h)
dim rspic,fileext,g
     set rspic=conn.execute("select articleid,title,includepic,defaultpic from article where defaultpic<>'' and includepic=true and passed=true order by articleid desc")
if rspic.bof or rspic.eof then
dim strnopic
   strnopic=strnopic + "<table width='98%'  border='0' align='center' cellpadding='0' cellspacing='4' class='border'>"
   strnopic=strnopic +"<tr><td><img src='images/nopic.gif' width='"&w&"' height='"&h&"'></td></tr>"               
   strnopic=strnopic +"</table>"
   response.write strnopic  
rspic.close
set rspic=nothing
else
dim strflash
if t=1 then
   strflash=strflash & "<table width='98%' height='98%'  border='0' align='center' cellpadding='0' cellspacing='4'>"
   for g=1 to i
      if rspic.eof then
   exit for
end if
   strflash=strflash & "<tr align='center'><td>"
   fileext=lcase(getfileExtName(rspic("defaultpic")))
if fileext="jpg" or fileext="bmp" or fileext="gif" or fileext="png" then
   strflash=strflash & "<a href='ArtRead.asp?articleid="&rspic("articleid")&"' target='_blank' title="&rspic("title")&"><img src='"&rspic("defaultpic")&"' width='"&w&"' height='"&h&"'border='0'></a>"
else if fileext="swf" then  
   strflash=strflash & "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0' width='"&w&"' height='"&h&"'>"
   strflash=strflash & "<param name='movie' value='"&rspic("defaultpic")&"'>"
   strflash=strflash & "<param name='quality' value='high'>"
   strflash=strflash & "<param name='play' value='-1'>"
   strflash=strflash & "<param name='loop' value='0'>"
   strflash=strflash & "<param name='Menu' value='-1'>"
   strflash=strflash & "<embed src='"&rspic("defaultpic")&"' quality='high' pluginspage='http://www.macromedia.com/go/getflashplayer' type='application/x-shockwave-flash' width='"&w&"' height='"&h&"'></embed>"
   strflash=strflash & "</object>"
end if
end if
if len(rspic("title"))>j then
   strflash=strflash & "<br><a href='ArtRead.asp?articleid="&rspic("articleid")&"' target='_blank' title="&rspic("title")&">"&left(rspic("title"),j)&"…</a></div>"
else
   strflash=strflash & "<br><a href='ArtRead.asp?articleid="&rspic("articleid")&"' target='_blank' title="&rspic("title")&">"&rspic("title")&"</a></div>"
end if
   strflash=strflash & ""
     rspic.movenext
next
   strflash=strflash & "</tr></td>"
   strflash=strflash &"</table>"
   response.write strflash 
 else
   strflash=strflash & "<table width='98%' height='98%'  border='0' align='center' cellpadding='0' cellspacing='4'><tr align='center' class='border'>"
for g=1 to i
if rspic.eof then
   exit for
end if
   strflash=strflash & "<td class='txt05'>"
   fileext=lcase(getfileExtName(rspic("defaultpic")))
if fileext="jpg" or fileext="bmp" or fileext="gif" or fileext="png" then
   strflash=strflash & "<a href='ArtRead.asp?articleid="&rspic("articleid")&"' target='_blank' title="&rspic("title")&"><img src='"&rspic("defaultpic")&"' width='"&w&"' height='"&h&"'border='0'></a>"   
else if fileext="swf" then  
   strflash=strflash & "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0' width='"&w&"' height='"&h&"'>"
   strflash=strflash & "<param name='movie' value='"&rspic("defaultpic")&"'>"
   strflash=strflash & "<param name='quality' value='high'>"
   strflash=strflash & "<param name='play' value='-1'>"
   strflash=strflash & "<param name='loop' value='0'>"
   strflash=strflash & "<param name='Menu' value='-1'>"
   strflash=strflash & "<embed src='"&rspic("defaultpic")&"' quality='high' pluginspage='http://www.macromedia.com/go/getflashplayer' type='application/x-shockwave-flash' width='"&w&"' height='"&h&"'></embed>"
   strflash=strflash & "</object>"
end if
end if
if len(rspic("title"))>j then
   strflash=strflash & "<br><a href='ArtRead.asp?articleid="&rspic("articleid")&"' target='_blank' title="&rspic("title")&">"&left(rspic("title"),j)&"…</a></div>"
else 
   strflash=strflash & "<br><a href='ArtRead.asp?articleid="&rspic("articleid")&"' target='_blank' title="&rspic("title")&">"&rspic("title")&"</a></div>"
end if
   'strflash=strflash & ""
    rspic.movenext
    next
    strflash=strflash & "</td>"
    strflash=strflash &"</tr></table>"
    response.write strflash 
 end if
    rspic.close
    set rspic=nothing
    end if
end sub
'======================================================================================
'功能：显示最新文章
'参数：s---显示类型 1:最新 2：推荐 3：热门 4:显示全部小类文章；i---文章数；j---标题长度；pro---是否显示文章属性图标 1：显示；hot---是否热门 1：显示；big---显示文章大类 1：显示；sma---显示文章小类 1：显示；aut---是否显示作者 1:显示；
'edi---是否显示编辑 1：显示；tim---上传时间 0:详细时间 1:[月-日] ；hit---点击数；mor---更多显示方式 1：显示分页 2：显示MORE 3：无）
'======================================================================================
sub shownewart(s,i,j,pro,hot,big,sma,aut,edi,tim,hit,mor)
dim rsnew,titlestr,h,page,filepath
set rsnew=server.createobject("ADODB.Recordset")
if s=2 then
rsnew.open"select * from article where elite='2' and passed=true order by ontop='1',articleid desc",conn,1,1
else 
if s=3 then
rsnew.open"select * from article where hot='3' and passed=true order by ontop='1',articleid desc",conn,1,1
else if s=4 then
rsnew.open"select * from article where bigclass='"&bigclass&"' and smallclass='"&smallclass&"' and passed=true order by ontop='1',articleid desc",conn,1,1
else
rsnew.open"select * from article where passed=true order by ontop='1',articleid desc",conn,1,1
end if
end if
end if
if rsnew.bof or rsnew.eof then
response.write"<li>还没有新文章</li>"
rsnew.close
set rsnew=nothing
else
if mor=1 then
   filepath=request.servervariables("path_info")
   page=request.querystring("page")
  rsnew.pagesize=i
  if not isempty(page) then
   if not isnumeric(page) then
    page=1
	 else
	 page=cint(page)
	 end if
	 if page>rsnew.pagecount then
	   rsnew.absolutepage=rsnew.pagecount
		elseif page<=0 then
		rsnew.absolutepage=1
		else
		 rsnew.absolutepage=page
		end if
		else
	rsnew.absolutepage=1
	end if
	page=rsnew.absolutepage
end if	
dim ss
if mor=1 then
   ss=rsnew.pagesize
else 
   ss=i
end if
   for h=1 to ss
       if rsnew.eof then
         exit for
       end if 
titlestr=titlestr &"<li>"
if pro=1 then
   if rsnew("ontop")=1 then
      titlestr=titlestr & "<img src='img/artstop.jpg' width=10 height=9 title='固顶文章'>"
   else 
       if rsnew("elite")=2 then
          titlestr=titlestr & "<img src='img/artselit.jpg' width=9 height=9 title='推荐文章'>"
		  else 
		     if rsnew("hot")=3 then
		       titlestr=titlestr & "<img src='img/artshot.jpg' width=10 height=9 title='热门文章'>"
		    else
		       titlestr=titlestr & "<img src='img/arts.jpg' width=10 height=9 title='普通文章'>"
		    end if
       end if
   end if
end if
select case rsnew("textclass")
       case 1
	   titlestr=titlestr & "[注]"
	   case 2
	   titlestr=titlestr & "[普]"
	   case 3
	   titlestr=titlestr & "[中]"
	   case 4
	   titlestr=titlestr & "[高]"
	   case 5
	   titlestr=titlestr & "[特]"