<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<%
'DVBBS 7.1.0 动网论坛首页调用-----论坛统计调用
dim bbsurl,lockurl
lockurl=""
'只允许调用网址,要以"HTTP://"开头,为空则不开放此功能.(可允许多网址限制，要以","分隔。)
'例如只允许此两个网址调用: lockurl="http://1sy.cn/,http://www.1sy.cn/"	
bbsurl="http://1sy.cn/bbs/"  '请填写你论坛的正确地址,要以"HTTP://"开头
'*************************************
'上传到与CONN.ASP同级的目录下
'以上地址参数一定要修改,否则所调用的链接是去了以上的论坛.
'若有问题,可以运行一起上传的newscode.ASP文件进行调试(newscode.ASP运行前要修改调用参数)
'	FSSUNWIN	2005.4.1
'*************************************
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)&"');"
Response.Write "document.write('<br> □- 最高在线 <font color=red>"&Dvbbs.Maxonline&"</font><br> □- 建站时间 "&FormatDateTime(Dvbbs.Forum_Setting(74),1)&"');"
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>&nbsp;&nbsp;');"
			ii=1
			t=1
		else
			if t>tbr then
			response.write "document.write('<BR>&nbsp;&nbsp;');"
			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&"index.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('&nbsp;&nbsp;├');"
		end select
		if SQL(2,k)>1 then
		for i=2 to SQL(2,k)
		response.write "document.write('&nbsp;&nbsp;│');"
		next
		response.write "document.write('&nbsp;&nbsp;├');"
		end if
		response.write "document.write('<a href="&bbsurl&"index.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 = Stringhtml(SQL(1,k))
	response.write "document.write('<font face=Wingdings color=#FFAA39>w</font>&nbsp;&nbsp;<a href="""&bbsurl&"announcements.asp?action=showone&boardid="& SQL(0,k) &"&id="&SQL(4,k)&""" target=""_blank"" title=""发表人:"&SQL(2,k)&"&nbsp;&nbsp;时间:"&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 = Stringhtml(SQL(1,k))
	response.write "document.write('<font face=Wingdings color=#FFAA39>w</font>&nbsp;&nbsp;<a href="""&bbsurl&"announcements.asp?action=showone&boardid="& SQL(0,k) &"&id="&SQL(4,k)&""" target=""_blank"" title=""发表人:"&SQL(2,k)&"&nbsp;&nbsp;时间:"&SQL(3,k)&""" onmouseover=""document.all.shownews.stop();"" onmouseout=""document.all.shownews.start();"">');"
	response.write "document.write('"&News&"');"
	response.write "document.write('</a>&nbsp;&nbsp;&nbsp;&nbsp;');"
	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

	Function Stringhtml(str)
		Dim re
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="<(.[^>]*)>"
		str=re.replace(str, "")
		're.Pattern="\[(.[^>]*)\]"
		'str=re.replace(str, "")
		str = Replace(str, CHR(34), """")
		str = Replace(str, CHR(39), "\'")
		str = Replace(str, CHR(13), "")
		str = Replace(str, CHR(10), "")
		str = replace(str, ">", "&gt;")
		str = replace(str, "<", "&lt;")
		if str="" then str="..."
		Stringhtml=str
	End Function
%>