char.asp

功能强大的一个b/s工作站

<TABLE border=0 width="100%" align=center>
<TR>
<TD align=left width="25%"><a href="<%= Forum_info(3) %>"><img border=0 src='<%= Forum_info(6) %>'></a></TD>
<TD Align=center width="65%">
<%if isnull(Forum_ads(0)) or Forum_ads(0)="" then%>
<object classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0" width="468" height="60"><param name=movie value="http://www.dvbbs.net/skin/default/dvbanner.swf"><param name=quality value=high><param name=menu value=false><embed src="http://www.dvbbs.net/skin/default/dvbanner.swf" quality=high pluginspage="http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash" type="application/x-shockwave-flash" width="468" height="60"></embed></object>
<%else%>
<%=Forum_ads(0)%>
<%end if%>
</td>
<td align=right style="line-height: 15pt" width="10%">
<a href=#><span style="CURSOR: hand" onClick="window.external.AddFavorite('<%=Forum_info(1)%>', '<%=Forum_info(0)%>')">加入收藏</span></a>
<br><a href="mailto:<%=Forum_info(5)%>">联系我们</a>
<br><a href="boardhelp.asp?boardid=<%=boardid%>">论坛帮助</a>
</td>
</td></tr>
</table>
</td></tr>
<tr><td class=TopLighNav height=9></td></tr>
        <tr> 
          <td class=TopLighNav1 height=22  valign="middle">&nbsp;&nbsp;
<%if not founduser then%>
<a href="login.asp">登陆</a> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="reg.asp">注册</a>
<%else%>
<%if userhidden=2 then%><a href="cookies.asp?action=hidden&userid=<%=userid%>">隐身</a><%else%><a href="cookies.asp?action=online&userid=<%=userid%>">上线</a><%end if%> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="login.asp">重登陆</a> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="usermanager.asp" onMouseOver='ShowMenu(manage,100)'>用户控制面板</a>
<%end if%>
 <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="query.asp?boardid=<%=boardid%>">搜索</a> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="#" onMouseOver='ShowMenu(stylelist,100)'>自选风格</a> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="boardstat.asp?boardid=<%=boardid%>" onMouseOver='ShowMenu(boardstat,100)'>论坛状态</a> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="show.asp?boardid=<%=boardid%>" onMouseOver='ShowMenu(downlist,100)'>论坛展区</a> <%if founduser then%> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="logout.asp">退出</a><%else%> <img src=<%=Forum_info(7)%>navspacer.gif align=absmiddle> <a href="dispuser.asp?boardid=<%=boardid%>&action=permission">我能做什么</a><%end if%>
<%if master then response.write " <img src="&Forum_info(7)&"navspacer.gif align=absmiddle> <a href=admin_index.asp>管理</a> <img src="&Forum_info(7)&"navspacer.gif align=absmiddle> <a href=""recycle.asp"">回收站</a>"%>
			</td>
        </tr>
</table>
</td></tr>
</table>
<%
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
%>