📄 char.asp

📁 asp构建网站bbs.采用B/S架构
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12

sub nav()
%>
<html>
<head>
<META http-equiv=Content-Type content=text/html; charset=gb2312>
<meta name=keywords content="动网先锋,动网论坛,dvbbs">
<title><%=Forum_info(0)%>--<%=stats%></title>
<!--#include file="Forum_css.asp"-->
<!--#include file="Forum_js.asp"-->
</head>
<body <%=Forum_body(11)%> onmousemove="HideMenu()">
<!-- 数码修改--增加页头换肤 -->
<!--#include file="../SkinPageTop.asp"-->
<!-- 数码修改--增加页头换肤结束 -->
<%
if Cint(GroupSetting(0))=0 and (instr(scriptname,"reg.asp")=0 and instr(scriptname,"login.asp")=0) then
	Errmsg=Errmsg+"<br>"+"<li>您没有浏览本论坛的权限，请<a href=login.asp>登陆</a>或者同管理员联系。"
	call head_var(2,0,"","")
	call dvbbs_error()
	call footer()
	response.end
end if
end sub

'入口参数
'IsBoard=1论坛分版面导航，IsBoard=0论坛其他页面导航，GetTitle论坛其他页面上级页面，GetUrl论坛其他页面上级页面URL
'Depth论坛分版面导航中论坛深度，其他页面设置为0
sub head_var(IsBoard,idepth,GetTitle,GetUrl)
%>
<table cellspacing=1 cellpadding=3 align=center border=0 width="<%=Forum_body(12)%>">
<tr>
<%if not founduser then%>
<td height=25>
<BR>
>> <%if foundboard then%><%=BoardReadme%><%else%>欢迎光临 <B><%=Forum_info(0)%></B><%end if%>
<%else%>
<td width=65% >
</td><td width=35% align=right>
<%if Cint(newincept())>Cint(0) then%>
<bgsound src="<%=Forum_info(7)&Forum_statePic(8)%>" border=0>
<%if Cint(forum_setting(10))=1 then%>
<script language=JavaScript>openScript('messanger.asp?action=read&id=<%=inceptid(1)%>&sender=<%=inceptid(2)%>',500,400)</script>
<%end if%>
<img src=<%=Forum_info(7)&Forum_boardpic(9)%>> <a href="usersms.asp?action=inbox">我的收件箱</a> (<a href="javascript:openScript('messanger.asp?action=read&id=<%=inceptid(1)%>&sender=<%=inceptid(2)%>',500,400)"><font color="<%=Forum_body(8)%>"><%=newincept()%> 新</font></a>)
<%else%>
<img src=<%=Forum_info(7)&Forum_boardpic(8)%>> <a href="usersms.asp?action=inbox">我的收件箱</a> (<font color=gray>0 新</font>)
<%end if%>
<%end if%>
</td></tr>
</table>
<table cellspacing=1 cellpadding=3 align=center class=tableBorder2>
<tr><td height=25 valign=middle>
<img src="<%=Forum_info(7)&Forum_pic(12)%>" align=absmiddle> <a href=index.asp><%=Forum_info(0)%></a> → 
<%
if IsBoard=1 then
	if BoardParentID>0 then
	for i=0 to idepth-1
		response.write "<a href=list.asp?boardid="&FBoardID(i)&">"&FBoardName(i)&"</a> →  "
		if i>9 then exit for
	next
	end if
	if request("CatLog")="NN" then
	Response.Cookies("BoardList")(BoardID & "BoardID")= "NNotShow"
	end if
	response.write "<a href=list.asp?boardid="&boardid&">"&boardtype&"</a> →  " & HTMLEncode(stats)
	if request.cookies("BoardList")(boardid & "BoardID")="NNotShow" then
	response.write "&nbsp;<a href=""?BoardID="&boardid&"&cBoardid="&boardid&"&Catlog=Y"" title=""展开论坛列表"">[展开]</a>"
	end if
elseif IsBoard=2 then
	response.write HTMLEncode(stats)
else
	response.write "<a href="&GetUrl&">"&GetTitle&"</a> → " & HTMLEncode(stats)
end if
%>
<a name=top></a>
</td></td>
</table>
<br>
<%
end sub

'统计留言
function newincept()
rs=conn.execute("Select Count(id) From Message Where flag=0 and issend=1 and delR=0 And incept='"& membername &"'")
    newincept=rs(0)
	set rs=nothing
	if isnull(newincept) then newincept=0
end function
function inceptid(stype)
	set rs=conn.execute("Select top 1 id,sender From Message Where flag=0 and issend=1 and delR=0 And incept='"& membername &"'")
	if stype=1 then
	inceptid=rs(0)
	else
	inceptid=rs(1)
	end if
	set rs=nothing
end function

Rem 获得版面用户组权限配置
function GetBoardPermission()
	dim pmrs
	GetBoardPermission=false
	set pmrs=conn.execute("select PSetting from BoardPermission where Boardid="&Boardid&" and GroupID="&UserGroupID)
	if not (pmrs.eof and pmrs.bof) then
		GetBoardPermission=true
		GroupSetting=split(pmrs(0),",")
	else
		GetBoardPermission=false
	end if
	if FoundUser then
	set pmrs=conn.execute("select uc_Setting from UserAccess where uc_BoardID="&BoardID&" and uc_UserID="&userID)
	if not(pmrs.eof and pmrs.bof) then
		UserPermission=split(pmrs(0),",")
		GroupSetting=split(pmrs(0),",")
		FoundUserPer=true
	end if
	end if
	set pmrs=nothing
end function


Rem 判断数字是否整形
function isInteger(para)
       on error resume next
       dim str
       dim l,i
       if isNUll(para) then 
          isInteger=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isInteger=false
          exit function
       end if
       l=len(str)
       for i=1 to l
           if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
              isInteger=false 
              exit function
           end if
       next
       isInteger=true
       if err.number<>0 then err.clear
end function

function allonline()
dim tmprs
tmprs=conn.execute("Select count(*) from online") 
allonline=tmprs(0) 
set tmprs=nothing 
if isnull(allonline) then allonline=0
end function

'**********************************************
'	vbs Cache类
'
'	属性valid，是否可用，取值前判断
'	属性name，cache名，新建对象后赋值
'	方法add(值,到期时间)，设置cache内容
'	属性value，返回cache内容
'	属性blempty，是否未设置值
'	方法makeEmpty，释放内存，测试用
'	方法equal(变量1)，判断cache值是否和变量1相同
'	方法expires(time)，修改过期时间为time
'	木鸟  2002.12.24
'	http://www.aspsky.net/
'**********************************************

class Cache
	private obj			'cache内容
	private expireTime		'过期时间
	private expireTimeName	'过期时间application名
	private cacheName		'cache内容application名
	private path			'uri
	
	private sub class_initialize()
		path=request.servervariables("url")
		path=left(path,instrRev(path,"/"))
	end sub
	
	private sub class_terminate()
	end sub
	
	public property get blEmpty
		'是否为空
		if isempty(obj) then
			blEmpty=true
		else
			blEmpty=false
		end if
	end property
	
	public property get valid
		'是否可用(过期)
		if isempty(obj) or not isDate(expireTime) then
			valid=false
		elseif CDate(expireTime)<now then
				valid=false
		else
			valid=true
		end if
	end property
	
	public property let name(str)
		'设置cache名
		cacheName=str & path
		obj=application(cacheName)
		expireTimeName=str & "expires" & path
		expireTime=application(expireTimeName)
	end property
	
	public property let expires(tm)
		'重设置过期时间
		expireTime=tm
		application.lock
		application(expireTimeName)=expireTime
		application.unlock
	end property
	
	public sub add(var,expire)
		'赋值
		if isempty(var) or not isDate(expire) then
			exit sub
		end if
		obj=var
		expireTime=expire
		application.lock
		application(cacheName)=obj
		application(expireTimeName)=expireTime
		application.unlock
	end sub
	
	public property get value
		'取值
		if isempty(obj) or not isDate(expireTime) then
			value=null
		elseif CDate(expireTime)<now then
			value=null
		else
			value=obj
		end if
	end property
	
	public sub makeEmpty()
		'释放application
		application.lock
		application(cacheName)=empty
		application(expireTimeName)=empty
		application.unlock
		obj=empty
		expireTime=empty
	end sub
	
	public function equal(var2)
		'比较
		if typename(obj)<>typename(var2) then
			equal=false
		elseif typename(obj)="Object" then
			if obj is var2 then
				equal=true
			else
				equal=false
			end if
		elseif typename(obj)="Variant()" then
			if join(obj,"^")=join(var2,"^") then
				equal=true
			else
				equal=false
			end if
		else
			if obj=var2 then
				equal=true
			else
				equal=false
			end if
		end if
	end function
end class
%>
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -