gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\usermanager.asp
<!--#include file="Conn.asp"--> <!-- #include file="inc/const.asp" --> <% Mybbs.LoadTemplates("usermanager") Mybbs.Stats=Mybbs.MemberName&template.Strings(0) Mybbs.Nav() Mybbs.Head_var 0,0,template.Strings(0),"usermanager.asp" Dim Sql,Rs,TempStr If Mybbs.userid=0 Then Mybbs.AddErrCode(6) Mybbs.Showerr() Else Main() End If Mybbs.ActiveOnline() Mybbs.Footer() Sub Main() Dim MainTable,User_info,i,UserFace User_info=Session(Mybbs.CacheName & "UserID") UserFace="<img src="""&Mybbs.HtmlEncode(User_info(11))&""" width="&User_info(12)&" height="&User_info(13)&" align=absmiddle >" MainTable=Template.Html(1) MainTable=Replace(MainTable,"{$TableWidth}",Mybbs.mainsetting(0)) MainTable=Replace(MainTable,"{$color}",Mybbs.mainsetting(1)) MainTable=Replace(MainTable,"{$user_Article}",User_info(8)) MainTable=Replace(MainTable,"{$user_Group}",User_info(18)) MainTable=Replace(MainTable,"{$user_Face}",Dv_FilterJS(UserFace)) MainTable=Replace(MainTable,"{$user_Title}",Mybbs.htmlencode(User_info(34))) MainTable=Replace(MainTable,"{$user_Wealth}",User_info(21)) MainTable=Replace(MainTable,"{$user_EP}",User_info(22)) MainTable=Replace(MainTable,"{$user_CP}",User_info(23)) MainTable=Replace(MainTable,"{$user_IsBest}",User_info(28)) MainTable=Replace(MainTable,"{$user_AddDate}",User_info(14)) MainTable=Replace(MainTable,"{$user_Logins}",User_info(16)) MainTable=Replace(MainTable,"{$username}",Mybbs.Membername) MainTable=Replace(MainTable,"{$msg_newincept}",Mybbs.sendmsgnum) MainTable=Replace(MainTable,"{$msg_incept}",incept()) MainTable=Replace(MainTable,"{$msg_send}",allsend()) MainTable=Replace(MainTable,"{$friend_Info}",friendlist()) '好友在线显示 MainTable=Replace(MainTable,"{$msglist}",msg_list(5)) '短信列 MainTable=Replace(MainTable,"{$filelist}",Fileuplist(5)) '上传文件列 'MainTable=Replace(MainTable,"{$topiclist}",NewTopic(5)) '新帖列 Response.Write Template.Html(0) Response.write MainTable End Sub Function msg_list(str) '短信列 Dim Tempwrite,Msgsrc,msgflag,tablebody,i sql="Select id,sender,title,content,flag,sendtime from DV_Message where incept='"&Mybbs.checkstr(Mybbs.MemberName)&"' and issend=1 and delR=0 order by flag,sendtime desc" Set Rs=Mybbs.Execute(sql) If Rs.eof and Rs.bof Then msg_list="<tr><td class=tablebody1 align=center valign=middle colspan=5>"&template.Strings(7)&"</td></tr>" Exit Function Else SQL=Rs.GetRows(cint(str)) Rs.close:set Rs=nothing For i=0 to Ubound(SQL,2) Tempwrite=Template.Html(2) msgflag=SQL(4,i) If msgflag=0 Then tablebody="tablebody2" Msgsrc="<img src="&template.pic(11)&" >" Else tablebody="tablebody1" Msgsrc="<img src="&template.pic(12)&" >" End If Tempwrite=Replace(Tempwrite,"{$tablebody}",tablebody) Tempwrite=Replace(Tempwrite,"{$msg_pic}",Msgsrc) Tempwrite=Replace(Tempwrite,"{$msg_name}",Mybbs.htmlencode(SQL(1,i))) Tempwrite=Replace(Tempwrite,"{$msg_id}",SQL(0,i)) Tempwrite=Replace(Tempwrite,"{$msg_topic}",Mybbs.htmlencode(SQL(2,i))) If Isnull(Sql(5,i)) Or SQL(5,i) = "" Then Tempwrite=Replace(Tempwrite,"{$msg_time}",Now()) Else Tempwrite=Replace(Tempwrite,"{$msg_time}",SQL(5,i)) End If Tempwrite=Replace(Tempwrite,"{$msg_size}",len(SQL(3,i))) msg_list=msg_list+Tempwrite Next End If End Function Function Fileuplist(str) '上传文件列 Dim Tempwrite,F_imgsrc,i Set Rs=Mybbs.Execute("Select F_ID,F_Filename,F_FileType,F_Type,F_Flag,F_FileSize,F_AddTime from [DV_Upfile] where F_UserID="&Mybbs.userid&" order by F_ID desc ") If Rs.eof and Rs.bof Then Fileuplist="<tr><td class=tablebody1 align=center valign=middle colspan=5>"&template.Strings(7)&"</td></tr>" Exit Function Else SQL=Rs.GetRows(cint(str)) Rs.close:set Rs=nothing For i=0 to Ubound(SQL,2) Tempwrite=Template.Html(3) Tempwrite=Replace(Tempwrite,"{$tablebody}","class=tablebody1") F_imgsrc="<img src='Skins/Default/filetype/"&SQL(2,i)&".gif' border=0>" Tempwrite=Replace(Tempwrite,"{$file_incept}",F_imgsrc) Tempwrite=Replace(Tempwrite,"{$file_size}",GetSize(SQL(5,i))) Tempwrite=Replace(Tempwrite,"{$file_time}",SQL(6,i)) Tempwrite=Replace(Tempwrite,"{$file_type}",F_Typename(SQL(3,i))) Tempwrite=Replace(Tempwrite,"{$file_topic}",Mybbs.Htmlencode(SQL(1,i))) Fileuplist=Fileuplist+Tempwrite Next End If End Function '<table cellpadding=3 cellspacing=1 align=center class=tableborder1 style="width:100%"> '<tr><th height=25 align=left>-=> 最近发表的文章</th></tr> '{$topiclist} '</table><br> Function NewTopic(str) '新帖列 Dim Tempwrite,topic,i Set Rs=Mybbs.Execute("Select announceid,rootid,boardid,dateandtime,topic,body from "&Mybbs.NowUseBbs&" where PostUserID="&Mybbs.userid&" and locktopic<2 order by announceid desc") If Not Rs.eof Then SQL=Rs.GetRows(cint(str)) Rs.close:set Rs=nothing For i=0 to Ubound(SQL,2) topic=replace(SQL(4,i)," ","") If topic<>"" Then topic=topic Else topic=SQL(5,i) topic=replace(topic,chr(13),"") topic=replace(topic,chr(10),"") End If If Len(topic)>30 Then topic=left(topic,30)&"..." End If topic=Mybbs.Htmlencode(topic) Tempwrite=Template.Html(4) Tempwrite=Replace(Tempwrite,"{$topic_title}","<a href=dispbbs.asp?boardid="&SQL(2,i)&"&id="&SQL(1,i)&"&replyid="&SQL(0,i)&"#"&SQL(0,i)&">"&topic&"</a>") Tempwrite=Replace(Tempwrite,"{$topic_posttime}",SQL(3,i)) NewTopic=NewTopic+Tempwrite Next Else Tempwrite=Template.Html(4) Tempwrite=Replace(Tempwrite,"{$topic_title}","") Tempwrite=Replace(Tempwrite,"{$topic_posttime}","") NewTopic=NewTopic+Tempwrite End If End Function Function friendlist() Dim FRs,OnlineTime,i,F_friend If Mybbs.Boardmaster or Mybbs.Master Then Set FRs=Mybbs.Execute("Select F_friend,(Select top 1 startime from Dv_online where username = DV_Friend.F_friend) From DV_Friend Where F_mod=1 AND F_userid="&Mybbs.Userid&" order by F_mod desc") Else Set FRs=Mybbs.Execute("Select F_friend,(Select top 1 startime from Dv_online where userhidden=2 and username = DV_Friend.F_friend) From DV_Friend Where F_mod=1 AND F_userid="&Mybbs.Userid&" order by F_mod desc") End If If FRs.eof and FRs.bof Then friendlist=template.Strings(8) Exit Function Else SQL=FRs.GetRows(10) End If FRs.close:set FRs=nothing For i=0 To Ubound(SQL,2) F_friend=Mybbs.checkstr(SQL(0,i)) If SQL(1,i)="" or isNull(SQL(1,i)) Then OnlineTime=Template.Strings(9) Else OnlineTime=template.Strings(10) OnlineTime=Replace(OnlineTime,"{$color}",Mybbs.mainsetting(1)) OnlineTime=Replace(OnlineTime,"{$OnlineTime}",DatedIff("n",SQL(1,i),Now())) End If friendlist=friendlist & "<a href=""javascript:openScript('messanger.asp?action=new&touser="&F_friend&"',500,400)"" ><img src="""&Mybbs.mainpic(15)&""" alt='给好友发送短讯' border=0></a> <a href=dispuser.asp?name="&F_friend&" >"&F_friend&"</a> "&OnlineTime&" <br>" Next End Function REM 统计已发出新短信 Function allsend() Set Rs=Mybbs.Execute("Select Count(id) From DV_Message Where flag=0 and issend=1 And sender='"& Mybbs.checkstr(Mybbs.MemberName) &"'") allsend=Rs(0) Rs.close If isnull(allsend) Then allsend=0 End Function REM 统计收件箱中的短信 Function incept() incept=0 Set Rs=Mybbs.Execute("Select Count(id) From DV_Message Where issend=1 and delR=0 And incept='"& Mybbs.checkstr(Mybbs.MemberName) &"'") incept=Rs(0) Rs.close If isnull(incept) Then incept=0 End Function Function F_Typename(str) DIM TempName TempName=split(Mybbs.lanstr(5),"||") If not IsEmpty(str) and isNumeric(str) Then Select case str case 1 F_Typename=TempName(1) case 2 F_Typename=TempName(2) case 3 F_Typename=TempName(3) case 4 F_Typename=TempName(4) case Else F_Typename=TempName(0) End Select End If End Function 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 GetSize(size) if isEmpty(size) then exit function if size>1024 then size=(size\1024) GetSize=size & " KB" else GetSize=size & " Byte" end if if size>1024 then size=(size/1024) GetSize=Formatnumber(size,2) & " MB" end if if size>1024 then size=(size/1024) GetSize=Formatnumber(size,2) & " GB" end if End Function 'Function SplitStr(str1,str2,str3) 'If IsEmpty(str1) or IsEmpty(str2) or not isNumeric(str3) Then Exit Function 'SplitStr=split(str1,str2)(str3) 'End Function %>