www.gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\dispuser.asp

    <!--#include file="conn.asp"-->
<!-- #include file="inc/const.asp" -->
<%
Mybbs.LoadTemplates("dispuser")
Dim ErrCodes,UserName,ShowUserid
UserName=Mybbs.CheckStr(Request("name"))
If IsNumeric(Request("id")) and Request("id")<>"" Then
	ShowUserid=Clng(Request("id"))
Else
	If UserName="" Then
		Mybbs.AddErrCode(35)
	End If
End If
If Cint(Mybbs.GroupSetting(1))=0 Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(1)
End If

Mybbs.Stats=Replace(template.Strings(0),"{$MemberName}",UserName)
Mybbs.Nav()
Mybbs.Head_var 2,0,Mybbs.Stats,"dispuser.asp"
Mybbs.Showerr()
If ErrCodes="" Then Main()
Showerr()
Mybbs.Showerr()
Mybbs.ActiveOnline
Mybbs.NewPassword()
Mybbs.Footer()

'0=UserID,1=UserName,2=UserPassword,3=UserEmail,4=UserPost,5=UserTopic,6=UserSign,7=UserSex,8=UserFace,9=UserWidth,10=UserHeight,11=UserIM,12=JoinDate,13=LastLogin,14=UserLogins,15=UserViews,16=Lockuser,17=Userclass,18=UserGroup,19=userWealth,20=userEP,21=userCP,22=UserTitle,23=UserBirthday,24=UserQuesion,25=UserAnswer,26=UserLastIP,27=UserPhoto,28=UserFav,29=UserPower,30=UserDel,31=UserIsBest,32=UserInfo,33=UserSetting,34=UserGroupID,35=TitlePic,36=UserHidden,37=UserMsg,38=IsChallenge,39=UserMobile
 
Sub Main()
Dim RS,SQL,UserInfo,i,UPSQL
Dim TempPart0,TempPart1,TempPart2,TempPart3,TempPart4,TempPart5
		i	= 0
TempPart0	= template.html(0)
TempPart1	= template.html(1)
TempPart2	= template.html(2)
TempPart3	= template.html(3)
TempPart4	= template.html(4)
TempPart5	= template.html(5)

UPSQL="update [Dv_user] set UserViews=UserViews+1 "
SQL=" Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSign,UserSex,UserFace,UserWidth,UserHeight,UserIM,JoinDate,LastLogin,UserLogins,UserViews,Lockuser,Userclass,UserGroup,userWealth,userEP,userCP,UserTitle,UserBirthday,UserQuesion,UserAnswer,UserLastIP,UserPhoto,UserFav,UserPower,UserDel,UserIsBest,UserInfo,UserSetting,UserGroupID,TitlePic,UserHidden,UserMsg,IsChallenge,UserMobile From [Dv_User] "
	If ShowUserid="" Then
		UPSQL=UPSQL + " Where Username='"&UserName&"'"
		SQL=SQL + " Where Username='"&UserName&"'"
	Else
		UPSQL=UPSQL + " Where Userid="&ShowUserid
		SQL=SQL + " Where Userid="&ShowUserid
	End If
	Set Rs=Mybbs.Execute(Sql)
	If Rs.Eof And Rs.Bof Then
		Mybbs.AddErrCode(32)
		Exit Sub
	Else
		Mybbs.Execute(UPSQL)
		'UserInfo=Rs.GetRows(1)
		SQL=Rs.GetString(,1, "@@@", "", "")
		Rs.Close:Set Rs=Nothing
	End if
	UserInfo=Split(Sql,"@@@")
	ShowUserid=Clng(UserInfo(0))
	UserName=UserInfo(1)
	Dim UserStats,UserOnTime
	If Mybbs.Boardmaster or Mybbs.Superboardmaster or Mybbs.Master Then
		Set Rs=Mybbs.Execute("Select Stats,Startime From Dv_Online Where Userid="&ShowUserid)
	Else
		Set Rs=Mybbs.Execute("Select Stats,Startime From Dv_Online Where Userid="&ShowUserid&" And Userhidden=2")
	End If
	If Rs.eof and Rs.bof Then
		UserStats=template.Strings(4)
		UserOnTime=template.Strings(4)
	Else
		UserStats=Rs(0)
		UserOnTime=DateDiff("n",Rs(1),Now())
		UserOnTime=Replace(template.Strings(3),"{$UserOnTime}",UserOnTime)
	End If
	Rs.close:Set Rs=Nothing
	Dim UserSetting,SetUserInfo,SetUserTrue
	UserSetting=split(UserInfo(33),"|||")
	If Ubound(UserSetting)>1 Then
		If not isnumeric(UserSetting(0)) Then SetUserInfo=1 Else SetUserInfo=cint(UserSetting(0))
		If not isnumeric(UserSetting(1)) Then SetUserTrue=0 Else SetUserTrue=cint(UserSetting(1))
	Else
		SetUserInfo=1
		SetUserTrue=0
	End If

	TempPart4=Replace(TempPart4,"{$UserName}",UserName)
	TempPart0=Replace(TempPart0,"{$TableWidth}",Mybbs.mainsetting(0))
	TempPart0=Replace(TempPart0,"{$UserFace}",Dv_FilterJS(UserInfo(8)))
	TempPart0=Replace(TempPart0,"{$UserName}",UserName)
	TempPart0=Replace(TempPart0,"{$WhereUser}",UserStats)
	TempPart0=Replace(TempPart0,"{$Pic_Stats}",template.pic(0))
	TempPart0=Replace(TempPart0,"{$UserStats}",LockUser(UserInfo(16)))
	TempPart0=Replace(TempPart0,"{$UserOnTime}",UserOnTime)
	Response.Write TempPart4
	Response.Write TempPart0

'基本资料部分
If SetUserInfo=1 or ShowUserid=Mybbs.userid Then
	Dim UserIM,Sex,UserPhoto	'UserIM=========HomePage,UserOicq,UserIcq,UserMsn,UserAim,UserYahoo,UserUC
	UserIM=Mybbs.htmlencode(UserInfo(11))
	UserIM=split(UserIM,"|||")
	If not IsArray(UserIM) Then ReDim UserIM(6)
	If UserInfo(7)=1 Then
		Sex=split(template.Strings(5),",")(1)
	Else
		Sex=split(template.Strings(5),",")(0)
	End If
	If UserInfo(27)<>"" Then UserPhoto="<img src="""&Dv_FilterJS(UserInfo(27)) &""" >"
	TempPart1=Replace(TempPart1,"{$UserBirthday}",UserInfo(23))
	TempPart1=Replace(TempPart1,"{$UserName}",UserName)
	TempPart1=Replace(TempPart1,"{$UserPhoto}",UserPhoto)
	TempPart1=Replace(TempPart1,"{$UserSex}",Sex)
	TempPart1=Replace(TempPart1,"{$Pic_Star}",astro(UserInfo(23)))
	TempPart1=Replace(TempPart1,"{$UserEmail}",UserInfo(3))
	TempPart1=Replace(TempPart1,"{$UserHomePage}",UserIM(0))
	TempPart1=Replace(TempPart1,"{$UserOicq}",UserIM(1))
	TempPart1=Replace(TempPart1,"{$UserIcq}",UserIM(2))
	TempPart1=Replace(TempPart1,"{$UserMsn}",UserIM(3))
	TempPart1=Replace(TempPart1,"{$UserAIM}",UserIM(4))
	TempPart1=Replace(TempPart1,"{$UserYahoo}",UserIM(5))
	TempPart1=Replace(TempPart1,"{$UserUC}",UserIM(6))
	TempPart1=Replace(TempPart1,"{$UserMobile}",UserInfo(39))
	Response.Write TempPart1
End If

'详细资料部分
If SetUserTrue=1 or ShowUserid=Mybbs.userid Then
	Dim UserTrueInFo
	UserTrueInFo=Mybbs.htmlencode(UserInfo(32))
	UserTrueInFo=Split(UserTrueInFo,"|||")
	If Not IsArray(UserTrueInFo) Or Ubound(UserTrueInFo)<>14 Then ReDim UserTrueInFo(14)
	TempPart2=Replace(TempPart2,"{$UserRealName}",UserTrueInFo(0))
	TempPart2=Replace(TempPart2,"{$UserCharacter}",UserTrueInFo(1))
	TempPart2=Replace(TempPart2,"{$User_Personal}",UserTrueInFo(2))
	TempPart2=Replace(TempPart2,"{$UserCountry}",UserTrueInFo(3))
	TempPart2=Replace(TempPart2,"{$UserProvince}",UserTrueInFo(4))
	TempPart2=Replace(TempPart2,"{$UserCity}",UserTrueInFo(5))
	TempPart2=Replace(TempPart2,"{$UserShengXiao}",UserTrueInFo(6))
	TempPart2=Replace(TempPart2,"{$UserBlood}",UserTrueInFo(7))
	TempPart2=Replace(TempPart2,"{$UserBelief}",UserTrueInFo(8))
	TempPart2=Replace(TempPart2,"{$UserOccupation}",UserTrueInFo(9))
	TempPart2=Replace(TempPart2,"{$UserMarital}",UserTrueInFo(10))
	TempPart2=Replace(TempPart2,"{$UserEducation}",UserTrueInFo(11))
	TempPart2=Replace(TempPart2,"{$UserCollege}",UserTrueInFo(12))
	TempPart2=Replace(TempPart2,"{$UserPhone}",UserTrueInFo(13))
	TempPart2=Replace(TempPart2,"{$UserAddress}",UserTrueInFo(14))
	Response.Write TempPart2
End If

'论坛属性部分
TempPart3=Replace(TempPart3,"{$color}",Mybbs.mainsetting(1))
REM 修正发帖数为空值时显示出错 2004-5-22 Dv.Yz
If Isnull(UserInfo(4)) Or Not Isnumeric(UserInfo(4)) Then UserInfo(4) = 0
TempPart3=Replace(TempPart3,"{$UserPost}",UserInfo(4))
TempPart3=Replace(TempPart3,"{$UserJoinDate}",UserInfo(12))
TempPart3=Replace(TempPart3,"{$UserLastLogin}",UserInfo(13))
TempPart3=Replace(TempPart3,"{$UserLogins}",UserInfo(14))
TempPart3=Replace(TempPart3,"{$UserClass}",UserInfo(17))
TempPart3=Replace(TempPart3,"{$UserGroup}",UserInfo(18))
TempPart3=Replace(TempPart3,"{$UserWealth}",UserInfo(19))
TempPart3=Replace(TempPart3,"{$UserEP}",UserInfo(20))
TempPart3=Replace(TempPart3,"{$UserCP}",UserInfo(21))
TempPart3=Replace(TempPart3,"{$UserPower}",UserInfo(29))
If Not IsNull(UserInfo(30)) And UserInfo(30)<>0 and UserInfo(4)<>0 Then
	TempPart3=Replace(TempPart3,"{$UserDelPC}",FormatPercent(UserInfo(30)/UserInfo(4)))
Else
	TempPart3=Replace(TempPart3,"{$UserDelPC}",UserInfo(30))
End If
TempPart3=Replace(TempPart3,"{$UserDel}",UserInfo(30))
TempPart3=Replace(TempPart3,"{$UserBest}",UserInfo(31))
TempPart3=Replace(TempPart3,"{$UserStock}",0)
TempPart3=Replace(TempPart3,"{$UserBank}",0)
TempPart3=Replace(TempPart3,"{$UserAssets}",UserInfo(19))
TempPart3=Replace(TempPart3,"{$UserAdmin}",GetAdminBoard(UserInfo(34),UserName))
Response.Write TempPart3

'快捷管理选项部分
If Mybbs.Superboardmaster or Mybbs.Master or (Mybbs.GroupSetting(43)=1 and Mybbs.GroupSetting(28)=1 and Mybbs.GroupSetting(29)=1) Then
	TempPart5=Replace(TempPart5,"{$UserName}",UserName)
	TempPart5=Replace(TempPart5,"{$UserID}",ShowUserid)
	TempPart5=Replace(TempPart5,"{$UserIP}",UserInfo(26))
	TempPart5=Replace(TempPart5,"{$UseTable}",UseTable)
	Response.Write TempPart5
End IF
End Sub

'(用户组ID,用户名)
Function GetAdminBoard(UserGroupID,username)
	Dim Srs,BoardMaster,i,ii,MyBoardMaster
	ii=0
	GetAdminBoard="<font color=gray>无职务</font>"
	If UserGroupID=1 Then
		GetAdminBoard="论坛管理员"
	ElseIf UserGroupID<=3 Then
		GetAdminBoard=""
		Set Srs=Mybbs.Execute("Select Boardmaster,Boardid,Boardtype From Dv_Board Where Boardmaster<>'' Order By Rootid,Orders")
		If not Srs.eof Then
			BoardMaster=Srs.GetRows(-1)
		Srs.Close:Set Srs=Nothing
		For i=0 to Ubound(BoardMaster,2)
			MyBoardMaster="|" & Trim(BoardMaster(0,i)) & "|"
			If instr(MyBoardMaster,"|" & username & "|")>0 Then
			ii=ii+1
				GetAdminBoard=GetAdminBoard&(ii)&": <a href=list.asp?boardid="&BoardMaster(1,i)&">"&BoardMaster(2,i)&"</a>  版主<br>"
			End If
			MyBoardMaster=""
		Next
		End if
		If GetAdminBoard="" Then GetAdminBoard="<font color=gray>无职务</font>"
	End If
End Function

'用户状态验证
Function LockUser(str)
If not IsNumeric(str) Then Exit Function
	Select case Cint(str)
	case 1 
		LockUser="锁定"
	case 2
		LockUser="屏蔽"
	case else
		LockUser="正常"
	End Select
End Function

'数据帖子列表
Function UseTable()
	DIM RS,SQL,i
	SET RS=Mybbs.Execute("Select TableName,TableType From Dv_TableList")
	If Not RS.EOF Then
		SQL=RS.GetRows(-1)
		RS.Close:Set RS=Nothing
		For i=0 to Ubound(SQL,2)
			UseTable=UseTable+"<option value="""&SQL(0,i)&""" "
			If Mybbs.nowusebbs=SQL(0,i) Then UseTable=UseTable+"selected"
			UseTable=UseTable+">"&SQL(1,i)&"</option>"
		Next
	End If
End Function

'显示错误信息
Sub Showerr()
Dim Show_Errmsg
	If ErrCodes<>"" Then 
		Show_Errmsg=Mybbs.mainhtml(14)
		ErrCodes=Replace(ErrCodes,"{$color}",Mybbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$color}",Mybbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$errtitle}",Mybbs.Forum_Info(0)&"-"&Mybbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$action}",Mybbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$ErrString}",ErrCodes)
	End If
	Response.write Show_Errmsg
End Sub

Function Dv_FilterJS(v)
	If  Not Isnull(V) Then
		Dim t
		Dim re
		Dim reContent
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="(&#)"
		t=re.Replace(v,"<I>&#</I>")
		re.Pattern="(script)"
		t=re.Replace(t,"<I>script</I>")
		re.Pattern="(js:)"
		t=re.Replace(t,"<I>js:</I>")
		re.Pattern="(value)"
		t=re.Replace(t,"<I>value</I>")
		re.Pattern="(about:)"
		t=re.Replace(t,"<I>about:</I>")
		re.Pattern="(file:)"
		t=re.Replace(t,"<I>file:</I>")
		re.Pattern="(Document.cookie)"
		t=re.Replace(t,"<I>Documents.cookie</I>")
		re.Pattern="(vbs:)"
		t=re.Replace(t,"<I>vbs:</I>")
		re.Pattern="(on(mouse|Exit|error|click|key))"
		t=re.Replace(t,"<I>on$2</I>")
		Dv_FilterJS=t
		Set Re=Nothing
	End If 
End Function

'日期转换星座函数
'白羊座,金牛座,双子座,巨蟹座,狮子座,处女座,天秤座,天蝎座,射手座,魔羯座,水瓶座,双鱼座
function astro(birth)
if birth="" or not isdate(birth) Then birth=now()
Dim birthday,birthmonth
Dim Star_name,Star_src
Star_name=Split(template.Strings(6),",")
IF not IsArray(Star_name) Then ReDim Star_name(12)
	birthday=day(birth)
	birthmonth=month(birth)
	select case birthmonth
	case 1
		if birthday>=21 then
			astro="<img src="""&template.pic(11)&""" alt="&Star_name(10)&birth&">"
		else
			astro="<img src="""&template.pic(10)&""" alt="&Star_name(9)&birth&">"
		end if
	case 2
		if birthday>=20 then
			astro="<img src="""&template.pic(11)&""" alt="&Star_name(11)&birth&">"
		else
			astro="<img src="""&template.pic(10)&""" alt="&Star_name(10)&birth&">"
		end if
	case 3
		if birthday>=21 then
			astro="<img src="""&template.pic(1)&""" alt="&Star_name(0)&birth&">"
		else
			astro="<img src="""&template.pic(12)&""" alt="&Star_name(11)&birth&">"
		end if
	case 4
		if birthday>=21 then
			astro="<img src="""&template.pic(2)&""" alt="&Star_name(1)&birth&">"
		else
			astro="<img src="""&template.pic(1)&""" alt="&Star_name(0)&birth&">"
		end if
	case 5
		if birthday>=22 then
			astro="<img src="""&template.pic(3)&""" alt="&Star_name(2)&birth&">"
		else
			astro="<img src="""&template.pic(2)&""" alt="&Star_name(1)&birth&">"
		end if
	case 6
		if birthday>=22 then
			astro="<img src="""&template.pic(4)&""" alt="&Star_name(3)&birth&">"
		else
			astro="<img src="""&template.pic(3)&""" alt="&Star_name(2)&birth&">"
		end if
	case 7
		if birthday>=23 then
			astro="<img src="""&template.pic(5)&""" alt="&Star_name(4)&birth&">"
		else
			astro="<img src="""&template.pic(4)&""" alt="&Star_name(3)&birth&">"
		end if
	case 8
		if birthday>=24 then
			astro="<img src="""&template.pic(6)&""" alt="&Star_name(5)&birth&">"
		else
			astro="<img src="""&template.pic(5)&""" alt="&Star_name(4)&birth&">"
		end if
	case 9
		if birthday>=24 then
			astro="<img src="""&template.pic(7)&""" alt="&Star_name(6)&birth&">"
		else
			astro="<img src="""&template.pic(6)&""" alt="&Star_name(5)&birth&">"
		end if
	case 10
		if birthday>=24 then
			astro="<img src="""&template.pic(8)&""" alt="&Star_name(7)&birth&">"
		else
			astro="<img src="""&template.pic(7)&""" alt="&Star_name(6)&birth&">"
		end if
	case 11
		if birthday>=23 then
			astro="<img src="""&template.pic(9)&""" alt="&Star_name(8)&birth&">"
		else
			astro="<img src="""&template.pic(8)&""" alt="&Star_name(7)&birth&">"
		end if
	case 12
		if birthday>=22 then
			astro="<img src="""&template.pic(10)&""" alt="&Star_name(9)&birth&">"
		else
			astro="<img src="""&template.pic(9)&""" alt="&Star_name(8)&birth&">"
		end if
	case else
		astro=""
	end select
end function
%>