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 %>