📄 tongji.asp
字号:
<!--#include file="conn.asp"-->
<!--#Include File="inc/Dv_ClsMain.asp"-->
<%
'DVBBS 7.0 动网论坛首页调用-----论坛统计调用
dim bbsurl,lockurl
lockurl=""
'只允许调用网址,要以"HTTP://"开头,为空则不开放此功能.(可允许多网址限制，要以","分隔。)
'例如只允许此两个网址调用: lockurl="http://www.artistsky.net/,http://www.artbbs.net/"
bbsurl="http://bbs.dvbbs.net/" '请填写你论坛的正确地址,要以"HTTP://"开头
'*************************************
'上传到与CONN.ASP同级的目录下
'以上地址参数一定要修改,否则所调用的链接是去了以上的论坛.
'若有问题,可以运行一起上传的newscode.ASP文件进行调试(newscode.ASP运行前要修改调用参数)
' FSSUNWIN 2003.12.31
'*************************************
if trim(lockurl)<>"" and checkserver(lockurl)=false then
response.write "document.write ('数据被保护,禁止被其他站点调用!');"
response.end
end if
Private function checkserver(str)
dim i,servername
checkserver=false
if str="" then exit function
str=split(Cstr(str),",")
servername=Request.ServerVariables("HTTP_REFERER")
for i=0 to Ubound(str)
if right(str(i),1)="/" then str(i)=left(trim(str(i)),len(str(i))-1)
if Lcase(left(servername,len(str(i))))=Lcase(str(i)) then
checkserver=true
exit for
else
checkserver=false
end if
next
end function
dim rs,sql,i,n
if trim(request("n"))<>"" and IsNumeric(request("n")) then
n=cint(request("n"))
else
n=1
end if
Dvbbs.GetForum_Setting
connectionDatabase
select case cint(request("orders"))
case 1
call tongji()
case 2
call topuser()
case 3
call adduser()
case 4
if trim(request("boardid"))<>"" and isnumeric(trim(request("boardid"))) then
if trim(request("boardid"))=0 then
call board(0,cint(trim(request("stats"))),cint(trim(request("model"))))
else
call board(cint(trim(request("boardid"))),cint(trim(request("stats"))),cint(trim(request("model"))))
end if
else
call board("all",cint(trim(request("stats"))),cint(trim(request("model"))))
end if
case 5
call bbsnews()
case else
call tongji()
end select
CloseObject
function allboys()
dim tmprs
tmprs=conn.execute("Select count(*) from [Dv_user] where UserSex='1' GROUP By UserSex ")
allboys=tmprs(0)
set tmprs=nothing
if isnull(allboys) then allboys=0
end function
sub tongji()
'Dim BoyNum
'BoyNum=allboys
Response.Write "document.write('□- 主题总数 "&Dvbbs.CacheData(7,0)&"<br> □- 论坛贴数 "&Dvbbs.CacheData(8,0)&"<br> □- 注册人数 "&Dvbbs.CacheData(10,0)&"<br> □- 论坛在线 <font color=red>"&MyBoardOnline.Forum_Online&"</font><br> □- 新进会员 <font color=red>"&Dvbbs.CacheData(14,0)&"</font>');"
'Response.Write "document.write('<br>□- 论坛女生 "&Dvbbs.CacheData(10,0)-BoyNum&" 位<br> □- 论坛男生 "&BoyNum&" 位');"
Response.Write "document.write('<br> □- 今日帖数 <font color=red>"&Dvbbs.CacheData(9,0)&"</font><br> □- 昨日贴数 "&Dvbbs.CacheData(11,0)&"<br> □- 高峰贴数 "&Dvbbs.CacheData(12,0)&"');"
end sub
sub topuser()
set rs=server.createobject("adodb.recordset")
sql="select top "&n&" userid,username from [Dv_user] order by UserPost desc,userid desc"
rs.open sql,conn,1,1
If Not RS.Eof then
SQL=Rs.GetRows(-1)
end if
rs.close:set rs=nothing
For i=0 To Ubound(SQL,2)
response.write "document.write('<font face=Wingdings color=#FFAA39>J</font> <a href="
Response.Write bbsurl
Response.Write "dispuser.asp?id="
Response.Write SQL(0,i)
Response.Write " target=_blank title=查看"
Response.Write Dvbbs.htmlencode(SQL(1,i))
Response.Write "的个人资料>');document.write('"
response.write Dvbbs.htmlencode(SQL(1,i))
response.write "</a>');document.write('<br>');"
next
end sub
sub adduser()
set rs=server.createobject("adodb.recordset")
sql="select top "&n&" userid,username from [Dv_user] order by userid desc"
rs.open sql,conn,1,1
If Not RS.Eof then
SQL=Rs.GetRows(-1)
end if
rs.close:set rs=nothing
For i=0 To Ubound(SQL,2)
response.write "document.write('<font face=Wingdings color=#FFAA39>J</font> <a href="
Response.Write bbsurl
Response.Write "dispuser.asp?id="
Response.Write SQL(0,i)
Response.Write " target=_blank title=查看"
Response.Write Dvbbs.htmlencode(SQL(1,i))
Response.Write "的个人资料>');document.write('"
response.write Dvbbs.htmlencode(SQL(1,i))
response.write "</a>');document.write('<br>');"
next
end sub
sub board(id,stat,model)
dim sqlstr,k,ii,jump,t,tbr,BoardType
ii=0
t=0
tbr=5
sqlstr=""
if trim(request("depth"))<>"" and isnumeric(trim(request("depth"))) then
sqlstr=" and depth<="&cint(trim(request("depth")))
end if
if id="all" then
if trim(request("depth"))<>"" then sqlstr="where "&replace(sqlstr," and","",1,1)
sql="select boardid,boardType,depth,Board_Setting from Dv_board "&sqlstr&" order by rootid,orders "
else
sql="select boardid,boardType,depth,Board_Setting from Dv_board where ParentID="&cint(id)&" "&sqlstr&" order by rootid,orders "
end if
set rs=conn.execute(sql)
If Not RS.Eof then
SQL=Rs.GetRows(-1)
end if
rs.close:set rs=nothing
For k=0 To Ubound(SQL,2)
BoardType=Replace(SQL(1,k),"'","\'")
if cint(stat)=1 and mid(SQL(3,k), 3, 1)=1 then
jump=true
else
jump=false
end if
if jump=false then
if model=1 then
select case SQL(2,k)
case 0
response.write "document.write('<br><font face=Wingdings color=#FFAA39><b>O</b></font> ');"
ii=0
t=0
case 1
t=t+1
if ii=0 then
response.write "document.write('<BR> ');"
ii=1
t=1
else
if t>tbr then
response.write "document.write('<BR> ');"
t=1
else
response.write "document.write('--');"
end if
end if
end select
if SQL(2,k)<2 then
response.write "document.write('<a href="&bbsurl&"list.asp?boardid="& SQL(0,k) &" target=_blank title=""欢迎参观"& BoardType &"!"">');"
response.write "document.write('"& BoardType &"');"
response.write "document.write('</a>');"
end if
else
select case SQL(2,k)
case 0
response.write "document.write('╋');"
ii=ii+1
response.write "document.write('("&ii&")');"
case 1
response.write "document.write(' ├');"
end select
if SQL(2,k)>1 then
for i=2 to SQL(2,k)
response.write "document.write(' │');"
next
response.write "document.write(' ├');"
end if
response.write "document.write('<a href="&bbsurl&"list.asp?boardid="& SQL(0,k) &" target=_blank title=""欢迎参观"& BoardType &"!"">');"
response.write "document.write('"& BoardType &"');"
response.write "document.write('</a><br>');"
end if
end if
next
end sub
sub bbsnews()
dim sqlstr,k,News
if trim(request("boardid"))<>"" and isnumeric(trim(request("boardid"))) then
sqlstr=" where boardid="&cint(trim(request("boardid")))&" "
else
sqlstr=" "
end if
sql="select top "&n&" boardid,title,username,addtime,id from Dv_bbsnews "&sqlstr&" order by id desc"
set rs=conn.execute(sql)
If Not RS.Eof then
SQL=Rs.GetRows(-1)
else
response.write "document.write('<b><a href="&bbsurl&"announcements.asp?boardid=0 target=_blank><ACRONYM TITLE=""当前没有公告"">当前没有公告</ACRONYM></a></b> ("& now() &")');"
exit sub
end if
rs.close:set rs=nothing
select case cint(request("model"))
case 1
For k=0 To Ubound(SQL,2)
News = Replace(SQL(1,k),"'","\'")
response.write "document.write('<font face=Wingdings color=#FFAA39>w</font> <a href="""&bbsurl&"announcements.asp?action=showone&boardid="& SQL(0,k) &"&id="&SQL(4,k)&""" target=""_blank"" title=""发表人:"&SQL(2,k)&" 时间:"&SQL(3,k)&""">');"
if request("tlen")<>"" and isnumeric(trim(request("tlen"))) then
if len(SQL(1,k))>Cint(request("tlen")) then
response.write "document.write('"&left(News,request("tlen"))&"...');"
else
response.write "document.write('"&News&"');"
end if
else
response.write "document.write('"&News&"');"
end if
response.write "document.write('</a><br>');"
next
case 2
response.write "document.write('<marquee id=""shownews"" behavior=""alternate"" direction=""left"" scrollamount=""4"" scrolldelay=""1"" hspace=""0"" vspace=""0"">');"
For k=0 To Ubound(SQL,2)
News = Replace(SQL(1,k),"'","\'")
response.write "document.write('<font face=Wingdings color=#FFAA39>w</font> <a href="""&bbsurl&"announcements.asp?action=showone&boardid="& SQL(0,k) &"&id="&SQL(4,k)&""" target=""_blank"" title=""发表人:"&SQL(2,k)&" 时间:"&SQL(3,k)&""" onmouseover=""document.all.shownews.stop();"" onmouseout=""document.all.shownews.start();"">');"
response.write "document.write('"&News&"');"
response.write "document.write('</a> ');"
next
response.write "document.write('</marquee>');"
case else
exit sub
end select
end sub
Sub CloseObject()
Set template = Nothing
Set MyBoardOnline = Nothing
Set Dvbbs = Nothing
Set Conn = Nothing
End Sub
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -