%
Dvbbs.LoadTemplates("usermanager")
Dvbbs.Stats=Dvbbs.MemberName&template.Strings(5)
Dvbbs.Nav()
Dvbbs.Head_var 0,0,template.Strings(0),"usermanager.asp"
Response.Write Template.Html(0)
If Dvbbs.Userid=0 Or Dvbbs.Userid="" Then Dvbbs.AddErrCode(6):Dvbbs.Showerr()
Dim ErrCodes,Rs,Sql,Redcolor
Dim UserFavName,FavName_id
Redcolor=Dvbbs.mainsetting(1)
Set Rs=Dvbbs.Execute("Select UserFav From [Dv_User] Where UserID="&Dvbbs.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 "
"
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 "
"
Call Main()
Dvbbs.Showerr()
Dvbbs.ActiveOnline()
Dvbbs.Footer()
Dvbbs.PageEnd()
'主页面
Sub Main()
Dim TempLateStr,TempWrite
TempLateStr=template.html(13)
TempLateStr=Replace(TempLateStr,"{$TableWidth}",Dvbbs.mainsetting(0))
TempLateStr=Replace(TempLateStr,"{$fav_name}",UserFavName)
UserFavName=Split(UserFavName,",")
TempWrite=""&Ubound(UserFavName)+1&""
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+""
Next
End Function
Function UserFavName_List
Dim ShowList,i,ShowName
If Ubound(UserFavName)<0 Then
UserFavName_List="
"
Exit Function
End If
For i=0 to Ubound(UserFavName)
ShowList=template.html(14)
If FavName_id=i Then
ShowName=""&UserFavName(i)&""
ShowList=Replace(ShowList,"{$FavName_pic}",Dvbbs.mainpic(12)) '打开
Else
ShowName=UserFavName(i)
ShowList=Replace(ShowList,"{$FavName_pic}",Dvbbs.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 Dvbbs.chkpost=False Then
Dvbbs.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='"&Dvbbs.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(Dvbbs.Forum_Setting(11))
Sql="select count(F_id) From [Dv_Friend] where F_userid="&Dvbbs.userid&" "&SearchStr
Set Rs=Dvbbs.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=Dvbbs.iCreateObject("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="&Dvbbs.userid&" "&SearchStr
Sql=Sql+" order by F.f_addtime desc"
Rs.Open Sql,Conn,1,1
Dvbbs.SqlQueryNum=Dvbbs.SqlQueryNum+1
If Rs.eof and Rs.bof Then
UserFriend_List="
"
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))
If Isnumeric(Friend_IM(1)) Then
ShowList = Replace(ShowList,"{$Friend_Oicq}","")
Else
ShowList = Replace(ShowList,"{$Friend_Oicq}","无")
End If
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 = ""
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 Dvbbs.chkpost=False Then
Dvbbs.AddErrCode(16)
Exit Sub
End If
Dim fav_name
fav_name=Dvbbs.checkstr(Replace(Request("FavName"),",",""))
If fav_name="" Then
ErrCodes=ErrCodes+"
"+template.Strings(49)
Exit Sub
ElseIf strLength(fav_name)>12 Then
ErrCodes=ErrCodes+"
"+template.Strings(42)
Exit Sub
Else
fav_name=","+Dvbbs.htmlencode(Trim(fav_name))
Sql="Update [Dv_User] Set UserFav=UserFav+'"&fav_name&"' Where UserId="&Dvbbs.UserID
Set Rs=Dvbbs.Execute(Sql)
Dvbbs.Dvbbs_Suc("
"+template.Strings(48))
End If
End Sub
'修改分组
Sub save_fav()
If Dvbbs.chkpost=False Then
Dvbbs.AddErrCode(16)
Exit Sub
End If
Dim fav_name
Dim Old_FavName
Old_FavName=Split(UserFavName,",")
fav_name=Dvbbs.checkstr(Request("fav_name"))
If instr(left(fav_name,1),",") or instr(right(fav_name,1),",") Then
ErrCodes=ErrCodes+"
"+template.Strings(49)
Exit Sub
End If
If strLength(fav_name)>250 or Ubound(Split(fav_name,","))>9 or Ubound(Split(fav_name,","))"+template.Strings(42)
Exit Sub
End If
If Replace(fav_name,",","")="" Then
ErrCodes=ErrCodes+"
"+template.Strings(49)
Exit Sub
End If
Sql="Update [Dv_User] Set UserFav='"&Dvbbs.htmlencode(fav_name)&"' Where UserId="&Dvbbs.UserID
Set Rs=Dvbbs.Execute(Sql)
Dvbbs.Dvbbs_Suc("
"+template.Strings(48))
End Sub
'批量移动
Sub MovFriend()
If Dvbbs.chkpost=False Then
Dvbbs.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
Dvbbs.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
Dvbbs.AddErrCode(35)
Exit Sub
ElseIf Not IsNumeric(fixid) Then
Dvbbs.AddErrCode(35)
Exit Sub
Else
Dvbbs.execute("Update Dv_Friend set F_Mod = "&Fav_id&" where F_userid="&Dvbbs.UserId&" and F_id in ("&f_id&")")
Dvbbs.Dvbbs_Suc("
"+template.Strings(47))
End If
End Sub
'删除分组
Sub Del_Fav()
Dim Old_FavName,New_FavName,Del_FavName,i
If Dvbbs.chkpost=False Then
Dvbbs.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='"&Dvbbs.checkstr(New_FavName)&"' Where UserId="&Dvbbs.UserID
Set Rs=Dvbbs.Execute(Sql)
Sql="Delete From Dv_Friend where F_userid="&Dvbbs.UserId&" and F_Mod="&FavName_id
Set Rs=Dvbbs.Execute(Sql)
Dvbbs.Dvbbs_Suc("
"+template.Strings(46))
Else
ErrCodes=ErrCodes+"
"+template.Strings(49)
Exit Sub
End If
End Sub
'删除好友
Sub DelFriend()
If Dvbbs.chkpost=False Then
Dvbbs.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
Dvbbs.AddErrCode(35)
Exit Sub
ElseIf Not IsNumeric(fixid) Then
Dvbbs.AddErrCode(35)
Exit Sub
Else
Dvbbs.execute("Delete From Dv_Friend where F_userid="&Dvbbs.UserId&" and F_id in ("&delid&")")
Dvbbs.Dvbbs_Suc("
"+template.Strings(46))
End If
End Sub
'清空好友
Sub AllDelFriend()
If Dvbbs.chkpost=False Then
Dvbbs.AddErrCode(16)
Exit Sub
End If
Dvbbs.execute("Delete From Dv_Friend where F_userid="&Dvbbs.UserId)
Dvbbs.Dvbbs_Suc("
"+template.Strings(45))
Session("ispost")="0"
End Sub
'保存添加好友
Sub saveF()
If Dvbbs.chkpost=False Then
Dvbbs.AddErrCode(16)
Exit Sub
End If
Dim i,incept,Fav_id,Friend_Name
If Request("myFriend")="" Then
ErrCodes=ErrCodes+"
"+template.Strings(35)
Exit Sub
Else
incept=Dvbbs.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=Dvbbs.Execute(Sql)
If Rs.eof and Rs.bof Then
ErrCodes=ErrCodes+"
"+RePlace(template.Strings(41),"{$NoUser}",Friend_Name)
Exit Sub
Else
Friend_Name=rs(0)
End If
Rs.close
If Dvbbs.membername=trim(Friend_Name) Then
ErrCodes=ErrCodes+"
"+template.Strings(40)
Exit Sub
End If
Sql="Select F_id From Dv_Friend Where F_userid="&Dvbbs.userid&" and F_friend='"&Friend_Name&"'"
Set Rs=Dvbbs.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 ("& Dvbbs.Userid &",'"& Dvbbs.membername &"','"& Friend_Name &"',"& SqlNowString &","& Fav_id &") "
DVBBS.execute(sql)
Else
ErrCodes=ErrCodes+"
"+RePlace(template.Strings(44),"{$IsUser}",Friend_Name)
Exit Sub
End If
If i>4 Then
ErrCodes=ErrCodes+"
"+template.Strings(42)
Exit Sub
End If
next
Dvbbs.Dvbbs_Suc("
"+template.Strings(43))
End Sub
'显示错误信息
Sub Showerr()
Dim Show_Errmsg
If ErrCodes<>"" Then
Show_Errmsg=Dvbbs.mainhtml(14)
ErrCodes=Replace(ErrCodes,"{$color}",Dvbbs.mainSetting(1))
Show_Errmsg=Replace(Show_Errmsg,"{$color}",Dvbbs.mainSetting(1))
Show_Errmsg=Replace(Show_Errmsg,"{$errtitle}",Dvbbs.Forum_Info(0)&"-"&Dvbbs.Stats)
Show_Errmsg=Replace(Show_Errmsg,"{$action}",Dvbbs.Stats)
Show_Errmsg=Replace(Show_Errmsg,"{$ErrString}",ErrCodes)
End If
Response.write Show_Errmsg
End Sub
%>