%
Dvbbs.LoadTemplates("usermanager")
Dim MySpace
Set MySpace = New Cls_Space
'Dvbbs.Stats = Dvbbs.MemberName & template.Strings(67)
If Cint(Dvbbs.GroupSetting(1))=0 And MySpace.Act="userinfo" Then
Response.redirect "showerr.asp?ErrCodes=
您没有浏览本论坛会员资料的权限,请登录或者同管理员联系。&action=OtherErr&autoreload=1"
Response.End
End If
Dvbbs.Stats = MySpace.Space_Info.getAttribute("title")&"--"&MySpace.Space_User.getAttribute("username") & template.Strings(67)
MySpace.Head()
If MySpace.Act = "saveedit" Then
SaveEdit()
ElseIf MySpace.Act = "saveskin" Then
SaveSkin()
Else
Main()
End If
Dvbbs.ActiveOnline()
Set MySpace = Nothing
Dvbbs.Footer()
Dvbbs.PageEnd()
Sub Main()
Dim Channals
If MySpace.Act="" and MySpace.ReCache=0 Then
Else
BoardList()
Set Channals = MySpace.Space_Info.selectSingleNode("leftchannal")
If Channals.childNodes.Length>0 and MySpace.Space_Info.getAttribute("s_style")<>"2" Then
GetChannalData Channals
End If
Set Channals = MySpace.Space_Info.selectSingleNode("rightchannal")
If Channals.childNodes.Length>0 and MySpace.Space_Info.getAttribute("s_style")<>"1" Then
GetChannalData Channals
End If
Set Channals = MySpace.Space_Info.selectSingleNode("mainchannal")
Select Case MySpace.Act
Case "userinfo"
Case "topic"
LoadChanalData Channals,"usertopic"
Case "reply"
LoadChanalData Channals,"userreply"
Case "board"
Case "modifyset"
If Not MySpace.Admin Then
Response.redirect "showerr.asp?ErrCodes=你没有权限修改别人的个性首页。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Case "modifyskin"
If Not MySpace.Admin Then
Response.redirect "showerr.asp?ErrCodes=你没有权限修改别人的个性首页。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Case Else
If Channals.childNodes.Length>0 Then
GetChannalData Channals
End If
End Select
End If
MySpace.TranTemplate()
End Sub
'获取频道数据
Sub GetChannalData(Node)
Dim ChildNode
For each ChildNode in Node.childNodes
LoadChanalData ChildNode,ChildNode.getAttribute("id")
Next
End Sub
Sub LoadChanalData(Node,Nodeid)
Select Case Nodeid
Case "userinfo"
Case "usertopic"
Load_UserTopic(Node)
Case "userreply"
Load_UserReply(Node)
Case "userfav"
Load_UserFav(Node)
Case "usermsg"
Load_UserMsg(Node)
Case "userfriend"
Load_UserFriend(Node)
Case "userbest"
Load_UserBest(Node)
Case "userupload"
Load_UserFiles(Node)
Case Else
End Select
End Sub
'SaveEdit()
'保存设置修改
Sub SaveEdit()
If Dvbbs.Userid=0 Then
Response.redirect "showerr.asp?ErrCodes=请登陆后再进行修改。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
If Not MySpace.Admin Then
Response.redirect "showerr.asp?ErrCodes=你没有权限修改别人的个性首页。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Dim layoutset
layoutset = Dvbbs.CheckNumeric(Request.Form("layoutset"))
If layoutset = 0 Then
layoutset = 1
End If
If Len(Request.Form("spacetitle"))>100 or Len(Request.Form("spacetitle"))<1 Then
Response.redirect "showerr.asp?ErrCodes=标题不能为空或者超出100个字符&action=NoHeadErr&autoreload=1"
Exit Sub
End If
If Len(Request.Form("spaceintro"))>250 or Len(Request.Form("spaceintro"))<1 Then
Response.redirect "showerr.asp?ErrCodes=简介不能为空或者超出250个字符&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Dim Rs,Sql
Dim Setting,IsMyindex,i,TempStr,S_css,S_id,Stylepath
Dim UserSetting
S_css = Request.Form("s_css")
Stylepath = Request.Form("stylepath")
IsMyindex = Request.Form("ismyindex")
UserSetting = ""
Setting = ""
S_id = Dvbbs.Checknumeric(Request.Form("styleid"))
If Request.Form("modify")="1" Then
If IsMyindex<>"" Then
IsMyindex = Dvbbs.CheckNumeric(IsMyindex)
'当发生设置更改时执行数据更新
If IsMyindex<>Cint(MySpace.Space_User.getAttribute("set4")) Then
MySpace.Space_User.attributes.getNamedItem("set4").text = IsMyindex
For i=1 to 4
UserSetting = UserSetting & Replace(MySpace.Space_User.getAttribute("set"&i),"|||","")
If i<4 Then UserSetting = UserSetting & "|||"
Next
Dvbbs.Execute("Update Dv_user Set Usersetting='"&Dvbbs.Checkstr(UserSetting)&"' where Userid="&MySpace.Sid)
End If
End If
For i=0 to 20
TempStr = Request.Form("set_"&i)
If TempStr="" Then TempStr = "0"
Setting = Setting & Replace(TempStr,",","")
If i<20 Then Setting = Setting & ","
Next
End If
'当选取风格
If S_id>0 Then
Set Rs = Dvbbs.execute("select top 1 s_css,s_path from Dv_Space_skin where id="&S_id)
If Not Rs.Eof Then
S_css = Rs(0)
Stylepath = Rs(1)
End If
Rs.Close
End If
'更新扩展频道数据,清理已删的频道
Dim Modules,TempMods,ModulesNode,Node
If Request.Form("modify")<>"1" Then
Modules = ""
TempMods = Request.Form("layoutleft")&","&Request.Form("layoutright")&","&Request.Form("layoutmain")
TempMods = Split(Lcase(TempMods),",")
For i = 0 to Ubound(TempMods)
If TempMods(i)<>"" Then
If Left(TempMods(i),4) = "mod_" Then
Modules = Modules & TempMods(i) & ","
End If
End If
Next
Set ModulesNode = MySpace.Space_Info.selectSingleNode("modules")
If ModulesNode.childnodes.length>0 Then
For Each Node in ModulesNode.childnodes
If Instr(","&Modules,","&Node.selectSingleNode("ModulePrefs").getAttribute("id")&",") = 0 Then
ModulesNode.RemoveChild(Node)
End If
Next
End If
End If
If Not IsObject(Conn) Then ConnectionDatabase
Sql = "Select Top 1 id,userid,username,title,intro,s_left,s_right,s_center,s_css,s_style,s_path,updatetime,[set],plusdb,cachedb,ownercachedb from [Dv_Space_user] where"
Sql = Sql & " Userid=" & MySpace.Sid
Set Rs=Dvbbs.iCreateObject("Adodb.RecordSet")
Rs.Open Sql,Conn,1,3
If Rs.Eof Then
Rs.AddNew
Rs(1) = Dvbbs.UserID
Rs(2) = Dvbbs.Membername
Rs(12) = "10,5,15,20,0,30,20,20,10,5,30,0,0,0,0,0,0,0,0,0,0"
End If
Rs(3) = Dvbbs.ChkBadWords(Request.Form("spacetitle"))
Rs(4) = Dvbbs.ChkBadWords(Request.Form("spaceintro"))
If Request.Form("modify")<>"1" Then
Rs(5) = Request.Form("layoutleft")
Rs(6) = Request.Form("layoutright")
Rs(7) = Request.Form("layoutmain")
End If
If Request.Form("modify")<>"1" Then
Rs(13) = ModulesNode.xml
End If
Rs(14) = "" '清空cachedb
Rs(15) = "" 'ownercachedb清空
Rs(9) = layoutset
If Stylepath<>"" and Stylepath<>MySpace.Space_Info.getAttribute("s_path") Then
Rs(10) = Replace(Stylepath,".","")
Else
Rs(10) = MySpace.Space_Info.getAttribute("s_path")
End If
Rs(11) = Now()
If S_css<>"" Then
Rs(8) = S_css
End If
If Setting<>"" and Request.Form("modify")="1" Then
Rs(12) = Setting
End If
Rs.Update
Rs.Close
Set Rs = Nothing
If Request.Form("modify")="1" Then
MySpace.Suc("设置保存成功!")
Else
Response.redirect "userspace.asp?sid="&MySpace.Sid
End If
End Sub
'保存风格修改
Sub SaveSkin()
If Dvbbs.Userid=0 Then
Response.redirect "showerr.asp?ErrCodes=请登陆后再进行修改。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
If Not MySpace.Admin Then
Response.redirect "showerr.asp?ErrCodes=你没有权限修改别人的个性首页。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Dim addtoskins,S_css
Dim Skin_name,Skin_Path
Dim Rs,Sql
Addtoskins = Request.Form("addtoskins")
S_css = Request.Form("s_css")
If S_css = "" Then
Response.redirect "showerr.asp?ErrCodes=样式CSS不能为空&action=NoHeadErr&autoreload=1"
Exit Sub
End If
'推荐风格
If Addtoskins="1" Then
Skin_name = Trim(Dvbbs.CheckStr(Request.Form("skinname")))
If Skin_name="" or Len(Skin_name)>50 Then
Response.redirect "showerr.asp?ErrCodes=风格名称不能为空或超过50个字符。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Set Rs = Dvbbs.Execute("Select Top 1 id from [Dv_Space_skin] where S_name='"&Skin_name&"' and s_userid<>"&MySpace.Sid)
If Not Rs.Eof Then
Response.redirect "showerr.asp?ErrCodes=该风格名称已被占用,请重新定义风格名称。&action=NoHeadErr&autoreload=1"
Exit Sub
End If
Rs.Close
Skin_Path = MySpace.CreatStylePath
Sql = "Select Top 1 s_name,s_username,s_userid,s_css,s_path,s_lock from [Dv_Space_skin] where s_userid="&MySpace.Sid
If Not IsObject(Conn) Then ConnectionDatabase
Set Rs=Dvbbs.iCreateObject("Adodb.RecordSet")
Rs.Open Sql,Conn,1,3
If Rs.Eof Then
Rs.AddNew
Rs(1) = Dvbbs.Membername
Rs(2) = MySpace.Sid
Rs(4) = Skin_Path 's_path
If Skin_Path<>"" Then
MySpace.CopyFolder MySpace.Space_Info.getAttribute("s_path"),Skin_Path
End If
End If
Rs(0) = Skin_name
Rs(3) = S_css
Rs(5) = 0 '修改后将转为审核状态 0:审核,1:公共
Rs.update
Rs.Close
Else
If Instr(MySpace.Space_Info.getAttribute("s_path"),"userskins")=0 Then
Skin_Path = MySpace.CreatStylePath
MySpace.CopyFolder MySpace.Space_Info.getAttribute("s_path"),Skin_Path
Addtoskins = 1
Else
Skin_Path = MySpace.Space_Info.getAttribute("s_path")
End If
End If
'重写CSS文件
If Instr(Skin_Path,"userskins") Then
MySpace.WriteFile MySpace.Space_Skinpath&Skin_Path&"style.css",S_css
End If
Sql = "Select Top 1 s_css,s_path,cachedb,ownercachedb from [Dv_Space_user] where Userid=" & MySpace.Sid
If Not IsObject(Conn) Then ConnectionDatabase
Set Rs=Dvbbs.iCreateObject("Adodb.RecordSet")
Rs.Open Sql,Conn,1,3
If Not Rs.Eof Then
Rs(0) = S_css
If Addtoskins="1" Then
Rs(1) = Skin_Path
End If
Rs(2) = ""
Rs(3) = ""
Rs.update
End If
Rs.Close
Set Rs = Nothing
MySpace.Suc("设置保存成功!")
End Sub
'检查节点是否存在,CLEAR:TRUE=删除下级所有子节点
Function CheckNodes(Node,Clear)
Dim TempNode
If Node.hasChildNodes Then
If Clear Then
For Each TempNode in Node.childNodes
Node.RemoveChild(TempNode)
Next
End If
End If
Set CheckNodes = Node
End Function
'获取用户精华数据
Sub Load_UserBest(Node)
Dim Rs,Sql,TopicNodes,TempNode,Nums
'Dv_BookMark
If Node is Nothing Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Nums = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_1"))
Sql = "Select top "&Nums&" id,Announceid,Rootid,boardid,title,PostUserName,PostUserid,dateandtime,expression from Dv_BestTopic where PostUserid="&MySpace.Sid&" order by id desc"
Set Rs = Dvbbs.Execute(sql)
If not Rs.Eof Then
SQL=Rs.GetRows(-1)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","userbest")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
If Not TopicNodes Is Nothing Then
For Each TempNode in TopicNodes.documentElement.childNodes
If Len(TempNode.getAttribute("title"))>25 Then
TempNode.attributes.getNamedItem("title").text=Dvbbs.ChkBadWords(Left(Dvbbs.Replacehtml(TempNode.getAttribute("title")),25))&"..."
Else
TempNode.attributes.getNamedItem("title").text=Dvbbs.ChkBadWords(Dvbbs.Replacehtml(TempNode.getAttribute("title")))
End If
TempNode.attributes.getNamedItem("dateandtime").text=Formatdatetime(cdate(TempNode.getAttribute("dateandtime")),2)
TempNode.setAttribute "isbest",1
Next
TopicStats_Pic(TopicNodes.documentElement)
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
'获取用户附件数据
Sub Load_UserFiles(Node)
Dim Rs,Sql,TopicNodes,TempNode
'Dv_BookMark
If Node is Nothing Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Dim HideBoards,Nums
Nums = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_3"))
HideBoards = " Not F_BoardID in("&LockBoards()&") "
Sql = "Select top "&Nums&" F_ID,F_BoardID,F_AnnounceID,F_Filename,F_Readme,F_Type,F_Flag,F_Viewname,F_Username,F_DownNum,F_ViewNum,F_FileType,F_AddTime from [DV_Upfile] where "&HideBoards&" and F_Flag<>4 and F_UserID ="&MySpace.Sid&" order by F_ID desc"
'Response.Write sql
Set Rs = Dvbbs.Execute(sql)
If not Rs.Eof Then
SQL=Rs.GetRows(-1)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","userfile")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
If Not TopicNodes Is Nothing Then
Dim F_AnnounceID
If Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UploadFile/"
If right(Dvbbs.Forum_Setting(76),1)<>"/" Then Dvbbs.Forum_Setting(76)=Dvbbs.Forum_Setting(76)&"/"
TopicNodes.documentElement.setAttribute "ishide",Dvbbs.Forum_Setting(75)
TopicNodes.documentElement.setAttribute "filepath",Dvbbs.Forum_Setting(76)
TopicNodes.documentElement.setAttribute "defaultfile",Dvbbs.Forum_Info(6)
For Each TempNode in TopicNodes.documentElement.childNodes
If Len(TempNode.getAttribute("f_readme"))>25 Then
TempNode.attributes.getNamedItem("f_readme").text=Dvbbs.ChkBadWords(Left(TempNode.getAttribute("f_readme"),25))&"..."
Else
TempNode.attributes.getNamedItem("f_readme").text=Dvbbs.ChkBadWords(TempNode.getAttribute("f_readme"))
End If
F_AnnounceID = Split(TempNode.getAttribute("f_announceid"),"|")
If Ubound(F_AnnounceID)>0 Then
TempNode.setAttribute "rootid",F_AnnounceID(1)
TempNode.setAttribute "announceid",F_AnnounceID(0)
End If
TempNode.removeAttribute "f_announceid"
TempNode.attributes.getNamedItem("f_addtime").text=Formatdatetime(cdate(TempNode.getAttribute("f_addtime")),2)
Next
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
'获取用户短信数据
Sub Load_UserMsg(Node)
Dim Rs,Sql,TopicNodes,TempNode,Nums
'Dv_BookMark
If Node is Nothing Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Nums = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_8"))
Sql = "Select top "&Nums&" id,sender,title,flag,sendtime from Dv_Message where incept='"&Dvbbs.Checkstr(MySpace.Space_Info.getAttribute("username"))&"' order by id desc"
Set Rs = Dvbbs.Execute(sql)
If not Rs.Eof Then
SQL=Rs.GetRows(20)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","usermsg")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
If Not TopicNodes Is Nothing Then
For Each TempNode in TopicNodes.documentElement.childNodes
If Len(TempNode.getAttribute("title"))>25 Then
TempNode.attributes.getNamedItem("title").text=Dvbbs.ChkBadWords(Left(Dvbbs.Replacehtml(TempNode.getAttribute("title")),25))&"..."
Else
TempNode.attributes.getNamedItem("title").text=Dvbbs.ChkBadWords(Dvbbs.Replacehtml(TempNode.getAttribute("title")))
End If
TempNode.attributes.getNamedItem("sendtime").text=Formatdatetime(cdate(TempNode.getAttribute("sendtime")),2)
Next
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
'获取用户收藏数据
Sub Load_UserFav(Node)
Dim Rs,Sql,TopicNodes,TempNode,Nums
'Dv_BookMark
If Node is Nothing Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Nums = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_9"))
Sql = "Select top "&Nums&" url,topic,addtime from Dv_BookMark where username='"&Dvbbs.Checkstr(MySpace.Space_Info.getAttribute("username"))&"' order by id desc"
Set Rs = Dvbbs.Execute(sql)
If not Rs.Eof Then
SQL=Rs.GetRows(-1)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","userfav")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
If Not TopicNodes Is Nothing Then
For Each TempNode in TopicNodes.documentElement.childNodes
If Len(TempNode.getAttribute("topic"))>25 Then
TempNode.attributes.getNamedItem("topic").text=Dvbbs.ChkBadWords(Left(Dvbbs.Replacehtml(TempNode.getAttribute("topic")),25))&"..."
Else
TempNode.attributes.getNamedItem("topic").text=Dvbbs.ChkBadWords(Dvbbs.Replacehtml(TempNode.getAttribute("topic")))
End If
TempNode.attributes.getNamedItem("addtime").text=Formatdatetime(cdate(TempNode.getAttribute("addtime")),2)
Next
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
'获取用户好友数据
'F_Mod 用户关系标识。 陌生人=0, 我的好友=1,黑名单=2
Sub Load_UserFriend(Node)
If Node is Nothing Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Dim Rs,Sql,TopicNodes,TempNode,Nums
Nums = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_10"))
Sql = "Select top "&Nums&" F_Friend,F_addtime,F_Mod From Dv_Friend where F_UserID="&MySpace.Sid&" order by F_mod,F_id desc"
Set Rs = Dvbbs.Execute(sql)
If not Rs.Eof Then
SQL=Rs.GetRows(-1)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","userfriend")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
If Not TopicNodes Is Nothing Then
For Each TempNode in TopicNodes.documentElement.childNodes
TempNode.attributes.getNamedItem("f_friend").text=Dvbbs.ChkBadWords(TempNode.getAttribute("f_friend"))
TempNode.attributes.getNamedItem("f_addtime").text=Formatdatetime(cdate(TempNode.getAttribute("f_addtime")),2)
Next
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
'获取主题数据
Sub Load_UserTopic(Node)
'读取用户主题
If Node is Nothing or MySpace.Sid=0 Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Dim Rs,Sql,SqlStr,TopicNodes,TempNode
Dim HideBoards
Dim Page,MaxRows,Endpage,CountNum,PageSearch,SqlString,i
PageSearch = ""
Endpage = 0
If MySpace.Act="topic" Then
MaxRows = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_6"))
Else
MaxRows = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_0"))
End If
CountNum = 0
Page = Request("Page")
If IsNumeric(Page) = 0 or Page="" Then Page=1
Page = Clng(Page)
HideBoards = " Not Boardid in ("&LockBoards()&") "
If MySpace.Act="topic" Then
Sql = "Select "
Else
Sql = "Select top "&MaxRows
End If
Sql = Sql & " topicid,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,expression,topicmode,mode,getmoney,getmoneytype,usetools,issmstopic,hidename"
SqlStr = " From dv_Topic Where "&HideBoards&" and PostUserID="&MySpace.Sid
Sql = Sql & SqlStr & " Order By TopicID Desc"
CountNum = Dvbbs.Execute("Select Count(topicid) "&SqlStr)(0)
Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1
If Not IsObject(Conn) Then ConnectionDatabase
Set Rs = Dvbbs.iCreateObject ("adodb.recordset")
Rs.Open Sql,Conn,1,1
If Not Rs.Eof Then
'CountNum = Rs.RecordCount
If CountNum Mod MaxRows=0 Then
Endpage = CountNum \ MaxRows
Else
Endpage = CountNum \ MaxRows+1
End If
Rs.MoveFirst
If Page > Endpage Then Page = Endpage
If Page < 1 Then Page = 1
If Page >1 Then
Rs.Move (Page-1) * MaxRows
End if
SQL=Rs.GetRows(MaxRows)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","topic")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
Dim Lastpost
If Not TopicNodes Is Nothing Then
TopicNodes.documentElement.setAttribute "endpage",Endpage
TopicNodes.documentElement.setAttribute "maxrows",MaxRows
TopicNodes.documentElement.setAttribute "countnum",CountNum
TopicNodes.documentElement.setAttribute "page",Page
TopicNodes.documentElement.setAttribute "pagesearch",PageSearch
TopicStats_Pic(TopicNodes.documentElement)
For Each TempNode in TopicNodes.documentElement.childNodes
TempNode.attributes.getNamedItem("title").text=Dvbbs.ChkBadWords(Dvbbs.Replacehtml(TempNode.getAttribute("title")))
TempNode.attributes.getNamedItem("postusername").text=Dvbbs.ChkBadWords(TempNode.getAttribute("postusername"))
i=0
For each lastpost in Split(TempNode.getAttribute("lastpost"),"$")
TempNode.setAttribute "lastpost_"& i,lastpost
i=i+1
Next
TempNode.removeAttribute "lastpost"
Next
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
'获取回复帖子数据
Sub Load_UserReply(Node)
'读取用户回复
If Node is Nothing or MySpace.Sid=0 Then
Exit Sub
Else
Set Node = CheckNodes(Node,true)
End If
Dim Rs,Sql,SqlStr,TopicNodes,HideBoards,TempNode
Dim Page,MaxRows,Endpage,CountNum,PageSearch,SqlString,i
PageSearch = ""
Endpage = 0
If MySpace.Act="reply" Then
MaxRows = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_7"))
Else
MaxRows = Dvbbs.CheckNumeric(MySpace.Space_Info.getAttribute("set_2"))
End If
CountNum = 0
Page = Request("Page")
If IsNumeric(Page) = 0 or Page="" Then Page=1
Page = Clng(Page)
HideBoards = " Not Boardid in("&LockBoards()&") "
If MySpace.Act="reply" Then
Sql = "Select"
Else
Sql = "Select top "&MaxRows
End If
Sql = Sql + " Announceid,BoardID,rootid,topic,Expression,username,postuserid,dateandtime,IsBest,LockTopic,Body,Length"
SqlStr = " From "&Dvbbs.NowUseBbs&" Where parentid>0 and "&HideBoards&" and PostUserID="&MySpace.Sid
Sql = Sql + SqlStr +" Order By Announceid Desc"
Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1
CountNum = Dvbbs.Execute("Select Count(Announceid) "+SqlStr)(0)
If Not IsObject(Conn) Then ConnectionDatabase
Set Rs = Dvbbs.iCreateObject ("adodb.recordset")
Rs.Open Sql,Conn,1,1
If Not Rs.Eof Then
'CountNum = Rs.RecordCount
If CountNum Mod MaxRows=0 Then
Endpage = CountNum \ MaxRows
Else
Endpage = CountNum \ MaxRows+1
End If
Rs.MoveFirst
If Page > Endpage Then Page = Endpage
If Page < 1 Then Page = 1
If Page >1 Then
Rs.Move (Page-1) * MaxRows
End if
SQL=Rs.GetRows(MaxRows)
Set TopicNodes = Dvbbs.ArrayToxml(sql,rs,"row","reply")
Else
Set TopicNodes = Nothing
End If
Rs.Close
Set Rs = Nothing
If Not TopicNodes Is Nothing Then
TopicNodes.documentElement.setAttribute "endpage",Endpage
TopicNodes.documentElement.setAttribute "maxrows",MaxRows
TopicNodes.documentElement.setAttribute "countnum",CountNum
TopicNodes.documentElement.setAttribute "page",Page
TopicNodes.documentElement.setAttribute "pagesearch",PageSearch
TopicStats_Pic(TopicNodes.documentElement)
For Each TempNode in TopicNodes.documentElement.childNodes
If TempNode.getAttribute("topic")="" Then
TempNode.attributes.getNamedItem("topic").text = Left(Dvbbs.Replacehtml(TempNode.getAttribute("body")),30)
Else
TempNode.attributes.getNamedItem("topic").text=Dvbbs.ChkBadWords(Dvbbs.Replacehtml(TempNode.getAttribute("topic")))
End If
TempNode.removeAttribute "body"
TempNode.attributes.getNamedItem("username").text=Dvbbs.ChkBadWords(TempNode.getAttribute("username"))
i=0
Next
Node.appendChild(TopicNodes.documentElement)
End If
End Sub
Sub BoardList()
MySpace.XmlDoc.DocumentElement.appendChild Application(Dvbbs.CacheName&"_boardlist").documentElement.cloneNode(True)
End Sub
'限制访问的版块ID列表
Function LockBoards()
Dim Nodes,ChildNode
Dim BoardList,i
If Dvbbs.Master or MySpace.Admin Then
LockBoards= "444"
Exit Function
End If
Set Nodes = Application(Dvbbs.CacheName&"_boardlist").documentElement.childNodes
i = 0
For Each ChildNode in Nodes
i = i+1
If ChildNode.getAttribute("checkout")="1" or ChildNode.getAttribute("hidden")=1 or ChildNode.getAttribute("checklock")=1 Then
BoardList = BoardList & ChildNode.getAttribute("boardid")
If i"" Then
BoardList = "444,777,"&BoardList
Else
BoardList= "444,777"
End If
If Right(BoardList,1)="," Then BoardList = Left(BoardList,Len(BoardList)-1)
LockBoards = BoardList
End Function
'添加帖子状态图标信息
Sub TopicStats_Pic(Node)
Node.setAttribute "bestpic",MySpace.Space_Info.getAttribute("skinpath")&"bestpic.gif" 'Dvbbs.mainpic(5)
Node.setAttribute "votepic",MySpace.Space_Info.getAttribute("skinpath")&"votepic.gif" 'Dvbbs.mainpic(6)
Node.setAttribute "islockpic",MySpace.Space_Info.getAttribute("skinpath")&"islockpic.gif" 'Dvbbs.mainpic(4)
Node.setAttribute "hotpic",MySpace.Space_Info.getAttribute("skinpath")&"hotpic.gif" 'Dvbbs.mainpic(3)
Node.setAttribute "openpic",MySpace.Space_Info.getAttribute("skinpath")&"openpic.gif" 'Dvbbs.mainpic(2)
Node.setAttribute "ispic",MySpace.Space_Info.getAttribute("skinpath")&"openpic.gif" 'Dvbbs.mainpic(1)
End Sub
%>