gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\friendlist.asp
<!--#include file="conn.asp"--> <!-- #include file="inc/const.asp" --> <!--#include file="inc/chkinput.asp"--> <% Mybbs.LoadTemplates("usermanager") Mybbs.Stats=Mybbs.MemberName&template.Strings(5) Mybbs.Nav() Mybbs.Head_var 0,0,template.Strings(0),"usermanager.asp" Response.Write Template.Html(0) If Mybbs.Userid=0 Or Mybbs.Userid="" Then Mybbs.AddErrCode(6):Mybbs.Showerr() Dim ErrCodes,Rs,Sql,Redcolor Dim UserFavName,FavName_id Redcolor=Mybbs.mainsetting(1) Set Rs=Mybbs.Execute("Select UserFav From [Dv_User] Where UserID="&Mybbs.userid) If Rs(0)<>"" Then UserFavName=Rs(0) Else UserFavName="" Rs.close Set Rs=Nothing If Request("fid")<>"" and IsNumeric(Request("fid")) Then FavName_id=cint(Request("fid")) Else FavName_id="" End If Response.Write "<div id=Fiend_act style=""display:none"">" Select Case Request("action") Case "creat" Call creat_fav() Case "editfav" Call save_fav() Case "favdel" Call del_fav() Case "addF" Call saveF() Case "saveF" Call saveF() Case "移动" Call MovFriend() Case "删除" Call DelFriend() case "清空好友" Call AllDelFriend() End Select If ErrCodes<>"" Then Showerr Response.Write "</div>" Call Main() Mybbs.Showerr() Mybbs.ActiveOnline() Mybbs.Footer() '主页面 Sub Main() Dim TempLateStr,TempWrite TempLateStr=template.html(13) TempLateStr=Replace(TempLateStr,"{$TableWidth}",Mybbs.mainsetting(0)) TempLateStr=Replace(TempLateStr,"{$fav_name}",UserFavName) UserFavName=Split(UserFavName,",") TempWrite="<font color="&Redcolor&">"&Ubound(UserFavName)+1&"</font>" TempLateStr=Replace(TempLateStr,"{$Fav_Select}",fav_select) TempLateStr=Replace(TempLateStr,"{$redcolor}",redcolor) TempLateStr=Replace(TempLateStr,"{$Fav_total}",TempWrite) TempLateStr=Replace(TempLateStr,"{$FavName_List}",UserFavName_List) TempLateStr=Replace(TempLateStr,"{$Friend_list}",UserFriend_List) Response.Write TempLateStr End Sub Function fav_select() Dim i For i=0 to Ubound(UserFavName) fav_select=fav_select+"<option value="""&i&""" >"&UserFavName(i)&"</option>" Next End Function Function UserFavName_List Dim ShowList,i,ShowName If Ubound(UserFavName)<0 Then UserFavName_List="<tr><td height=""20"" colspan=""3"" class=tablebody1 align=center style=""color:"&Redcolor&""">" UserFavName_List=UserFavName_List&template.Strings(8)&"</td></tr>" Exit Function End If For i=0 to Ubound(UserFavName) ShowList=template.html(14) If FavName_id=i Then ShowName="<font color="&Redcolor&">"&UserFavName(i)&"</font>" ShowList=Replace(ShowList,"{$FavName_pic}",Mybbs.mainpic(12)) '打开 Else ShowName=UserFavName(i) ShowList=Replace(ShowList,"{$FavName_pic}",Mybbs.mainpic(13)) '关闭 End If ShowList=Replace(ShowList,"{$FavName_Name}",ShowName) ShowList=Replace(ShowList,"{$FavName_id}",i) UserFavName_List=UserFavName_List+ShowList Next End Function Function UserFriend_List() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Function End If Dim CurrentPage,page_count,totalrec,Pcount,endpage,i Dim SearchStr,ShowList Dim Friend_IM,HomePage_Img,Oicq_img,Sms_Img,Msg_Img CurrentPage = Request("page") page_count=0 If CurrentPage <> "" And IsNumeric(CurrentPage) Then CurrentPage = Clng(CurrentPage) Else CurrentPage = 1 End If If Request("action")="search" Then If Request("fid")<>"" And IsNumeric(Request("fid")) Then SearchStr=SearchStr+" And F_Mod="&cint(Request("fid")) End If If Request("SearchInfo")<>"" Then SearchStr=SearchStr+" And F_friend='"&Mybbs.Checkstr(Request("SearchInfo"))&"'" End If Else End If HomePage_Img = ImgSrc(template.pic(15)) Oicq_img = ImgSrc(template.pic(16)) Msg_Img = ImgSrc(template.pic(17)) Sms_Img = ImgSrc(template.pic(18)) Dim PageListNum PageListNum=Cint(Mybbs.Forum_Setting(11)) Sql="select count(F_id) From [Dv_Friend] where F_userid="&Mybbs.userid&" "&SearchStr Set Rs=Mybbs.Execute(Sql) totalrec=Rs(0) Rs.close If totalrec mod PageListNum=0 Then Pcount= totalrec \ PageListNum Else Pcount= totalrec \ PageListNum+1 End If if currentpage > Pcount then currentpage = Pcount if currentpage<1 then currentpage=1 Set Rs=Server.Createobject("adodb.recordset") Sql="select F.F_id,F.F_userid,F.F_Friend,F_Mod,U.UserEmail,U.UserIM From [Dv_Friend] F inner join [Dv_user] U on F.F_Friend=U.username where F.F_userid="&Mybbs.userid&" "&SearchStr Sql=Sql+" order by F.f_addtime desc" Rs.Open Sql,Conn,1,1 Mybbs.SqlQueryNum=Mybbs.SqlQueryNum+1 If Rs.eof and Rs.bof Then UserFriend_List="<tr><td height=""20"" colspan=""7"" class=tablebody1 align=center style=""color:"&Redcolor&""">" UserFriend_List=UserFriend_List+template.Strings(8) UserFriend_List=UserFriend_List+"</td></tr>" Exit Function Else 'Rs.MoveFirst Rs.Move (currentpage-1) * Cint(PageListNum) SQL=Rs.GetRows(PageListNum) Rs.Close:Set Rs=Nothing End If For i=0 To Ubound(SQL,2) ShowList=template.html(15) If SQL(5,i)="" or isnull(SQL(5,i)) Then ShowList=Replace(ShowList,"{$Friend_HomePage}","") ShowList=Replace(ShowList,"{$Friend_Oicq}","") Else Friend_IM=split(SQL(5,i),"|||") ShowList=Replace(ShowList,"{$Friend_HomePage}",Friend_IM(0)) ShowList=Replace(ShowList,"{$Friend_Oicq}",Friend_IM(1)) End If ShowList=Replace(ShowList,"{$F_id}",SQL(0,i)) ShowList=Replace(ShowList,"{$FavName}",UserFavName(SQL(3,i))) ShowList=Replace(ShowList,"{$Friend_UserName}",SQL(2,i)) ShowList=Replace(ShowList,"{$Friend_Email}",SQL(4,i)&"") ShowList=Replace(ShowList,"{$Img_HomePage}",HomePage_Img) ShowList=Replace(ShowList,"{$Img_Oicq}",Oicq_img) ShowList=Replace(ShowList,"{$Img_Msg}",Msg_Img) ShowList=Replace(ShowList,"{$Img_sms}",Sms_Img) UserFriend_List=UserFriend_List+ShowList page_count=page_count+1 Next UserFriend_List=UserFriend_List+ShowPage(CurrentPage,Pcount,totalrec,PageListNum) End Function '图片输出 Function ImgSrc(str) If str="" Then Exit Function ImgSrc = "<img src="&str&" border=0>" End Function '分页输出 Function ShowPage(CurrentPage,Pcount,totalrec,PageNum) Dim SearchStr SearchStr=Request("action") ShowPage=template.html(16) ShowPage=Replace(ShowPage,"{$colSpan}",7) ShowPage=Replace(ShowPage,"{$CurrentPage}",CurrentPage) ShowPage=Replace(ShowPage,"{$Pcount}",Pcount) ShowPage=Replace(ShowPage,"{$PageNum}",PageNum) ShowPage=Replace(ShowPage,"{$totalrec}",totalrec) ShowPage=Replace(ShowPage,"{$SearchStr}",SearchStr) ShowPage=Replace(ShowPage,"{$redcolor}",redcolor) End Function '创建分组 Sub Creat_fav() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Dim fav_name fav_name=Mybbs.checkstr(Replace(Request("FavName"),",","")) If fav_name="" Then ErrCodes=ErrCodes+"<li>"+template.Strings(49) Exit Sub ElseIf strLength(fav_name)>12 Then ErrCodes=ErrCodes+"<li>"+template.Strings(42) Exit Sub Else fav_name=","+Mybbs.htmlencode(Trim(fav_name)) Sql="Update [Dv_User] Set UserFav=UserFav+'"&fav_name&"' Where UserId="&Mybbs.UserID Set Rs=Mybbs.Execute(Sql) Mybbs.Dvbbs_Suc("<li>"+template.Strings(48)) End If End Sub '修改分组 Sub save_fav() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Dim fav_name Dim Old_FavName Old_FavName=Split(UserFavName,",") fav_name=Mybbs.checkstr(Request("fav_name")) If instr(left(fav_name,1),",") or instr(right(fav_name,1),",") Then ErrCodes=ErrCodes+"<li>"+template.Strings(49) Exit Sub End If If strLength(fav_name)>250 or Ubound(Split(fav_name,","))>9 or Ubound(Split(fav_name,","))<Ubound(Old_FavName) Then ErrCodes=ErrCodes+"<li>"+template.Strings(42) Exit Sub End If If Replace(fav_name,",","")="" Then ErrCodes=ErrCodes+"<li>"+template.Strings(49) Exit Sub End If Sql="Update [Dv_User] Set UserFav='"&Mybbs.htmlencode(fav_name)&"' Where UserId="&Mybbs.UserID Set Rs=Mybbs.Execute(Sql) Mybbs.Dvbbs_Suc("<li>"+template.Strings(48)) End Sub '批量移动 Sub MovFriend() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Dim Fav_id Dim f_id,fixid If Request("Fav_id")<>"" And IsNumeric(Request("Fav_id")) Then Fav_id=Cint(Request("Fav_id")) Else Mybbs.AddErrCode(35) Exit Sub End If f_id=replace(Request.form("id"),"'","") f_id=replace(f_id,";","") f_id=replace(f_id,"--","") f_id=replace(f_id,")","") fixid=replace(f_id,",","") fixid=Trim(replace(fixid," ","")) If f_id="" or isnull(f_id) Then Mybbs.AddErrCode(35) Exit Sub ElseIf Not IsNumeric(fixid) Then Mybbs.AddErrCode(35) Exit Sub Else Mybbs.execute("Update Dv_Friend set F_Mod = "&Fav_id&" where F_userid="&Mybbs.UserId&" and F_id in ("&f_id&")") Mybbs.Dvbbs_Suc("<li>"+template.Strings(47)) End If End Sub '删除分组 Sub Del_Fav() Dim Old_FavName,New_FavName,Del_FavName,i If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Old_FavName=Split(UserFavName,",") Del_FavName=Old_FavName(FavName_id) For i=0 To Ubound(Old_FavName) If Old_FavName(i)<>Del_FavName Then New_FavName=New_FavName+Old_FavName(i) If i<>Ubound(Old_FavName) Then If (i=(Ubound(Old_FavName)-1) and FavName_id=Ubound(Old_FavName)) Then New_FavName=New_FavName Else New_FavName=New_FavName+"," End If End If End If Next New_FavName = Replace(New_FavName,",,",",") If instr(left(New_FavName,1),",") Then New_FavName = Replace(New_FavName,",","",1,1) If Replace(New_FavName,",","")<>"" And FavName_id>2 Then Sql="Update [Dv_User] Set UserFav='"&Mybbs.checkstr(New_FavName)&"' Where UserId="&Mybbs.UserID Set Rs=Mybbs.Execute(Sql) Sql="Delete From Dv_Friend where F_userid="&Mybbs.UserId&" and F_Mod="&FavName_id Set Rs=Mybbs.Execute(Sql) Mybbs.Dvbbs_Suc("<li>"+template.Strings(46)) Else ErrCodes=ErrCodes+"<li>"+template.Strings(49) Exit Sub End If End Sub '删除好友 Sub DelFriend() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Dim delid,fixid delid=replace(Request.form("id"),"'","") delid=replace(delid,";","") delid=replace(delid,"--","") delid=replace(delid,")","") fixid=replace(delid,",","") fixid=Trim(replace(fixid," ","")) If delid="" Or isnull(delid) Then Mybbs.AddErrCode(35) Exit Sub ElseIf Not IsNumeric(fixid) Then Mybbs.AddErrCode(35) Exit Sub Else Mybbs.execute("Delete From Dv_Friend where F_userid="&Mybbs.UserId&" and F_id in ("&delid&")") Mybbs.Dvbbs_Suc("<li>"+template.Strings(46)) End If End Sub '清空好友 Sub AllDelFriend() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Mybbs.execute("Delete From Dv_Friend where F_userid="&Mybbs.UserId) Mybbs.Dvbbs_Suc("<li>"+template.Strings(45)) Session("ispost")="0" End Sub '保存添加好友 Sub saveF() If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Exit Sub End If Dim i,incept,Fav_id,Friend_Name If Request("myFriend")="" Then ErrCodes=ErrCodes+"<li>"+template.Strings(35) Exit Sub Else incept=Mybbs.checkStr(Request("myFriend")) incept=split(incept,",") End If If Request("Fav_id")<>"" And IsNumeric(Request("Fav_id")) then Fav_id=cint(Request("Fav_id")) Else Fav_id=0 End If For i=0 To ubound(incept) Friend_Name=trim(incept(i)) Sql="select username from [Dv_User] where username='"&Friend_Name&"'" Set Rs=Mybbs.Execute(Sql) If Rs.eof and Rs.bof Then ErrCodes=ErrCodes+"<li>"+RePlace(template.Strings(41),"{$NoUser}",Friend_Name) Exit Sub Else Friend_Name=rs(0) End If Rs.close If Mybbs.membername=trim(Friend_Name) Then ErrCodes=ErrCodes+"<li>"+template.Strings(40) Exit Sub End If Sql="Select F_id From Dv_Friend Where F_userid="&Mybbs.userid&" and F_friend='"&Friend_Name&"'" Set Rs=Mybbs.Execute(Sql) If Rs.eof and Rs.bof Then Sql="Insert into Dv_Friend (F_Userid,F_UserName,F_Friend,F_addTime,F_Mod) values ("& Mybbs.Userid &",'"& Mybbs.membername &"','"& Friend_Name &"',"& SqlNowString &","& Fav_id &") " Mybbs.execute(sql) Else ErrCodes=ErrCodes+"<li>"+RePlace(template.Strings(44),"{$IsUser}",Friend_Name) Exit Sub End If If i>4 Then ErrCodes=ErrCodes+"<li>"+template.Strings(42) Exit Sub End If next Mybbs.Dvbbs_Suc("<li>"+template.Strings(43)) End Sub '显示错误信息 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 %>