<% Const PageSize=50 Dim XMLDOM,EmotPath,UserName,PostBuyUser,replyid_a,RootID_a,AnnounceID_a Dim dv_ubb Dim T_GetMoneyType,T_GetMoney,T_UseTools If IpInList Then Select Case Request("action") Case "","0" GetPostData() Case "1" GetBestTopic() Case "2" hotTopic() Case "3" GetUserData() Case "4" GetForumInfo() Case "5" GetForumPic() End Select End If Dvbbs.PageEnd() Sub hotTopic() Dim Rs,SQL,SQL1,Rs1,page,PageCount,node,node1,blist,TopicNum blist=boardlists() page=Request("tid") If Not IsNumeric(Page) Then Page="1" If Page="" Then Page="1" Page=CLng(Page) Set Rs=Dvbbs.iCreateObject("Adodb.RecordSet") If IsSqlDataBase = 1 Then SQL="Select TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Boardid in ("& blist &") and Datediff(d,LastPostTime, " & SqlNowString & ") < 5 order by hits Desc" 'SQL1="Select count(*) From Dv_topic Where Boardid in("& blist &") and Datediff(d,LastPostTime, " & SqlNowString & ") < 15 And hits > 20" Else SQL="Select TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Boardid in("& blist &") and Datediff('d',LastPostTime, " & SqlNowString & ") < 5 order by hits Desc" 'SQL1="Select count(*) From Dv_Topic Where Boardid in ("& blist &") and Datediff('d',LastPostTime, " & SqlNowString & ") < 15 And hits > 20" End If 'Set Rs1=Dvbbs.Execute(SQL1) '计算一下当前Page参数是否合法。如果超出范围,强制为最后一页 If Not IsObject(Conn) Then ConnectionDatabase Rs.Open Sql,Conn,1,1 If Rs.Eof And Rs.Bof Then Exit Sub TopicNum = Rs.Recordcount If TopicNum mod Pagesize =0 then PageCount= TopicNum \ Pagesize Else PageCount= TopicNum \ Pagesize+1 End If If Page > PageCount Then Page=PageCount Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDOM.appendChild(XMLDOM.createElement("hotlist")) Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"listinfo","")) Node.attributes.setNamedItem(XMLDom.createNode(2,"count","")).text =TopicNum Node.attributes.setNamedItem(XMLDom.createNode(2,"page","")).text=Page Node.attributes.setNamedItem(XMLDom.createNode(2,"pagesize","")).text=pagesize Node.attributes.setNamedItem(XMLDom.createNode(2,"lastpage","")).text=PageCount If TopicNum <> 0 and Not IsNull(TopicNum)Then 'Set Rs=Dvbbs.Execute(SQL) If Not page=1 Then Rs.Move(pagesize*(page-1)) SQL=RS.GetRows(Pagesize) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows") For each node1 in node.documentElement.selectNodes("row") If node1.selectSingleNode("@hidename").text="1" Then node1.selectSingleNode("@postusername").text="匿名用户" End If Next XMLDom.documentElement.appendChild(node.documentElement) Rs.Close:Set Rs=Nothing End If 'Rs1.Close:Set Rs1=Nothing Response.Clear Select Case Session.CodePage Case 65001 Response.CharSet="utf-8" Response.Write ""&vbNewLine Case 936 Response.CharSet="gb2312" Response.Write ""&vbNewLine Case 950 Response.CharSet="big5" Response.Write ""&vbNewLine End Select Response.ContentType="text/xml" Response.Write XMLDom.documentElement.XML End Sub Function boardlists() Dim xml,node,blist Set XML=Application(Dvbbs.CacheName&"_boardlist").cloneNode(True) If Dvbbs.GroupSetting(37)="0" Then For each node in XML.documentElement.selectNodes("board[@hidden=1 or @checkout=1]") XML.documentElement.removeChild(node) Next Else For each node in XML.documentElement.selectNodes("board[@checkout=1]") XML.documentElement.removeChild(node) Next End If blist="" For each node in XML.documentElement.selectNodes("board") If blist="" Then blist=Node.selectSingleNode("@boardid").text Else blist=blist&","&Node.selectSingleNode("@boardid").text End If Next boardlists=blist End Function Sub GetBestTopic() Dim Rs,SQL,SQL1,Rs1,page,PageCount,node,node1 page=Request("tid") If Not IsNumeric(Page) Then Page="1" If Page="" Then Page="1" Page=CLng(Page) SQL="Select TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where isbest=1 order by topicid Desc" SQL1="Select count(*) From Dv_topic Where isbest=1" Set Rs1=Dvbbs.Execute(SQL1) '计算一下当前Page参数是否合法。如果超出范围,强制为最后一页 If Rs1(0) mod Pagesize =0 then PageCount= Rs1(0) \ Pagesize Else PageCount= Rs1(0) \ Pagesize+1 End If If Page > PageCount Then Page=PageCount Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDOM.appendChild(XMLDOM.createElement("bestlist")) Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"listinfo","")) Node.attributes.setNamedItem(XMLDom.createNode(2,"count","")).text =Rs1(0) Node.attributes.setNamedItem(XMLDom.createNode(2,"page","")).text=Page Node.attributes.setNamedItem(XMLDom.createNode(2,"pagesize","")).text=pagesize Node.attributes.setNamedItem(XMLDom.createNode(2,"lastpage","")).text=PageCount If Rs1(0) <> 0 and Not IsNull(Rs1(0))Then Set Rs=Dvbbs.Execute(SQL) If Not page=1 Then Rs.Move(pagesize*(page-1)) SQL=RS.GetRows(Pagesize) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows") For each node1 in node.documentElement.selectNodes("row") If node1.selectSingleNode("@hidename").text="1" Then node1.selectSingleNode("@postusername").text="匿名用户" End If Next XMLDom.documentElement.appendChild(node.documentElement) Rs.Close:Set Rs=Nothing End If Rs1.Close:Set Rs1=Nothing Response.Clear Select Case Session.CodePage Case 65001 Response.CharSet="utf-8" Response.Write ""&vbNewLine Case 936 Response.CharSet="gb2312" Response.Write ""&vbNewLine Case 950 Response.CharSet="big5" Response.Write ""&vbNewLine End Select Response.ContentType="text/xml" Response.Write XMLDom.documentElement.XML End Sub Sub GetPostData() Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDOM.Load Server.MapPath(MyDbPath &"inc\templates\bbsinfo.xml") XMLDOM.documentElement.selectSingleNode("LastTid").text=GetLastPostID() XMLDOM.documentElement.selectSingleNode("Version").text=fVersion XMLDOM.documentElement.selectSingleNode("BBSName").text=Server.HtmlEncode(Dvbbs.Forum_info(0) & "") XMLDOM.documentElement.selectSingleNode("BBSURL").text=Dvbbs.Get_ScriptNameUrl() Dim tid,rs,tRs,node,boardid,RootID,posttable,SQL,node1,getmoneytype,body,Node2 tid=Request("tid") If IsNumeric(tid) and tid<>"" Then Set Rs=Dvbbs.Execute("select * From dv_topic Where topicid="& tid) If Not Rs.EOF Then Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"ChannelInfo","")) If rs("boardid")<>444 and Rs("boardid")<> 777 Then boardid=Rs("boardid") Else boardid=rs("locktopic") End If Node.appendChild(XMLDOM.createNode(1,"ForumName","")).text=Server.HtmlEncode(Getbbsname(boardid) & "") Node.appendChild(XMLDOM.createNode(1,"ForumUrl","")).text=Dvbbs.Get_ScriptNameUrl()&"index.asp?boardid="&boardid Node.appendChild(XMLDOM.createNode(1,"ForumType","")).text="科技" Select Case Session.CodePage Case 65001 Node.appendChild(XMLDOM.createNode(1,"Language","")).text="utf-8" Case 936 Node.appendChild(XMLDOM.createNode(1,"Language","")).text="GBK" Case 950 Node.appendChild(XMLDOM.createNode(1,"Language","")).text="Big5" End Select Node.appendChild(XMLDOM.createNode(1,"ForumID","")).text=BoardID Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"StatusElement","")) Node.appendChild(XMLDOM.createNode(1,"Link","")).text=Dvbbs.Get_ScriptNameUrl()&"dispbbs.asp?boardid="&boardid&"&id="&Rs("topicid") Node.appendChild(XMLDOM.createNode(1,"ReplyTime","")).text=DateDiff("s","1970-01-01",Rs("LastPostTime")) Node.appendChild(XMLDOM.createNode(1,"PostTime","")).text=DateDiff("s","1970-01-01",Rs("DateAndTime")) Node.appendChild(XMLDOM.createNode(1,"ReplyNum","")).text=Rs("Child") Node.appendChild(XMLDOM.createNode(1,"ViewNum","")).text=Rs("hits") If Rs("istop")=0 Then Node.appendChild(XMLDOM.createNode(1,"Sticky","")).text="false" Else Node.appendChild(XMLDOM.createNode(1,"Sticky","")).text="true" End If If Rs("isbest")=1 Then Node.appendChild(XMLDOM.createNode(1,"Digest","")).text="true" Else Node.appendChild(XMLDOM.createNode(1,"Digest","")).text="false" End If If Rs("boardid")=444 Then Node.appendChild(XMLDOM.createNode(1,"Deleted","")).text="true" Else Node.appendChild(XMLDOM.createNode(1,"Deleted","")).text="false" End If If Rs("locktopic") > 2 and rs("boardid")<>444 and Rs("boardid")<> 777 Then Node.appendChild(XMLDOM.createNode(1,"Locked","")).text="true" Else Node.appendChild(XMLDOM.createNode(1,"Locked","")).text="false" End If If (Dvbbs.GroupSetting(2)="1" and GetBoardhidden(boardid)=0 and checkoutbaord(Boardid)=0 and Rs("getmoneytype") <> 3) Then Node.appendChild(XMLDOM.createNode(1,"Access","")).text="true" Else Node.appendChild(XMLDOM.createNode(1,"Access","")).text="false" End If RootID=Rs("topicid") posttable=Rs("posttable") getmoneytype=Rs("getmoneytype") Dvbbs.LoadTemplates("") EmotPath=Split(Dvbbs.Forum_emot,"|||")(0) 'em心情路径 Set dv_ubb=new Dvbbs_UbbCode dv_ubb.PostType=1 SQL="Select top 50 AnnounceID,UserName,Topic,body,signflag,isbest,PostUserid,GetMoneyType,rootid,Ubblist,LockTopic,GetMoney,UseTools,PostBuyUser,ParentID,IsUpload From "& posttable &" where RootID="& RootId &" and Boardid="& Boardid&" Order By ParentID,dateandtime" Set Rs=Dvbbs.Execute(SQL) If Not Rs.EOF Then Do while Not Rs.EOF If Rs("ParentID")=0 Then Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"PageInfo","")) Else Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"ReplyInfo","")) End If Set node1=node.appendChild(XMLDOM.createNode(1,"ContentElement","")) Node1.appendChild(XMLDOM.createNode(1,"Title","")).text=Server.HtmlEncode(Dvbbs.ChkBadWords(Rs("topic"))) 'If Rs("isbest")=0 or Dvbbs.GroupSetting(41)="1" Then If Rs("LockTopic")=0 Then body=Dvbbs.ChkBadWords(Rs("body")) UserName=Rs("username") PostBuyUser=rs("postbuyuser") ReplyID_a=rs("announceid") RootID_a=rs("rootid") AnnounceID_a=ReplyID_a Ubblists=Rs("ubblist")&"" If InStr(Ubblists,",39,") > 0 Then body = dv_ubb.Dv_UbbCode(body,10,1,0) Else body = dv_ubb.Dv_UbbCode(body,10,1,1) End If Else body="内容被限制或禁止" End If 'Else ' body="精华贴,需要权限方可查看" 'End If body=replace(body,"]]>","]]>") Node1.appendChild(XMLDOM.createNode(1,"Content","")).appendChild(XMLDOM.createCDATASection(body)) If Rs("signflag")=2 Then Node1.appendChild(XMLDOM.createNode(1,"Author","")).text="" Else Node1.appendChild(XMLDOM.createNode(1,"Author","")).text=Server.HtmlEncode(Dvbbs.ChkBadWords(Rs("username"))) End If If Rs("IsUpload") = 1 Then Set tRs = Dvbbs.Execute("Select F_FileName,F_FileType,F_FileSize From Dv_Upfile Where F_AnnounceID='"&Rs("RootID")&"|"&Rs("AnnounceID")&"'") Do While Not tRs.Eof Set node2=node1.appendChild(XMLDOM.createNode(1,"Attachment","")) node2.appendChild(XMLDOM.createNode(1,"URL","")).text=Dvbbs.Get_ScriptNameUrl() & Dvbbs.Forum_Setting(76) & tRs(0) Select Case tRs(1) Case "asf","asr","asx" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="video/x-ms-" & tRs(1) Case "bmp","gif","png" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="image/" & tRs(1) Case "tif","tiff" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="image/tiff" Case "jpe","jpeg","jpg" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="image/jpeg" Case "mpe","mpeg","mpg" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="video/mpeg" Case "css" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="text/css" Case "txt" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="text/plain" Case "js" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="text/javascript" Case "avi" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="video/x-msvideo" Case "zip","rar" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/" & tRs(1) Case "ppt","pps","pot" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/vnd.ms-powerpoint" Case "ra","ram","rm","rmvb" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="audio/x-pn-realaudio" Case "swf","fla" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/x-shockwave-flash" Case "doc","dot" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/msword" Case "xla","xlc","xlm","xls","xlw" node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/vnd.ms-excel" Case Else node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/" & tRs(1) End Select node2.appendChild(XMLDOM.createNode(1,"FileName","")).text=Split(tRs(0),"/")(Ubound(Split(tRs(0),"/"))) node2.appendChild(XMLDOM.createNode(1,"Size","")).text=tRs(2) node2.appendChild(XMLDOM.createNode(1,"Description","")).text=Server.HtmlEncode(Dvbbs.ChkBadWords(Rs("topic"))&"") tRs.MoveNext Loop tRs.Close:Set tRs=Nothing End If Rs.MoveNext Loop End If End If Rs.Close:Set Rs=Nothing End If Response.Clear Select Case Session.CodePage Case 65001 Response.CharSet="utf-8" Response.Write ""&vbNewLine Case 936 Response.CharSet="gb2312" Response.Write ""&vbNewLine Case 950 Response.CharSet="big5" Response.Write ""&vbNewLine End Select Response.ContentType="text/xml" Response.Write XMLDom.documentElement.XML End Sub Sub GetUserData() Dim iUserID,Rs,Sql,node,node1,blist iUserID = Request("tid") If iUserID = "" Or Not IsNumeric(iUserID) Then Exit Sub Set Rs=Dvbbs.Execute("Select UserID,UserName,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,IsChallenge,UserMobile,TitlePic,UserTitle,UserAnswer From Dv_User Where UserID = " & iUserID) If Rs.Eof And Rs.Bof Then Rs.Close:Set Rs=Nothing Exit Sub Else Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDOM.appendChild(XMLDOM.createElement("userinfo")) Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"userencode","")) Node.attributes.setNamedItem(XMLDom.createNode(2,"encodestr","")).text = MD5(Rs("UserAnswer") & ":" & FormatDateTime(Rs("JoinDate"),2),32) SQL=RS.GetRows(1) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows") For each node1 in node.documentElement.selectNodes("row") node1.selectSingleNode("@useranswer").text="加密字段" Next XMLDom.documentElement.appendChild(node.documentElement) End If Rs.Close:Set Rs=Nothing Response.Clear Select Case Session.CodePage Case 65001 Response.CharSet="utf-8" Response.Write ""&vbNewLine Case 936 Response.CharSet="gb2312" Response.Write ""&vbNewLine Case 950 Response.CharSet="big5" Response.Write ""&vbNewLine End Select Response.ContentType="text/xml" Response.Write XMLDom.documentElement.XML End Sub Sub GetForumInfo() Dim Rs,Sql,node,node1,blist,iUserID blist=boardlists() iUserID = Request("tid") If iUserID = "" Or Not IsNumeric(iUserID) Then iUserID = 0 iUserID = cCur(iUserID) Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDOM.appendChild(XMLDOM.createElement("foruminfo")) Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"baseforuminfo","")) Node.attributes.setNamedItem(XMLDom.createNode(2,"forumname","")).text = Dvbbs.Forum_Info(0) Node.attributes.setNamedItem(XMLDom.createNode(2,"forumurl","")).text = Dvbbs.Forum_Info(1) Node.attributes.setNamedItem(XMLDom.createNode(2,"homename","")).text = Dvbbs.Forum_Info(2) Node.attributes.setNamedItem(XMLDom.createNode(2,"homeurl","")).text = Dvbbs.Forum_Info(3) Node.attributes.setNamedItem(XMLDom.createNode(2,"systememail","")).text = Dvbbs.Forum_Info(5) Node.attributes.setNamedItem(XMLDom.createNode(2,"topicnum","")).text = Dvbbs.CacheData(7,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"postnum","")).text = Dvbbs.CacheData(8,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"todaynum","")).text = Dvbbs.CacheData(9,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"yestodaynum","")).text = Dvbbs.CacheData(11,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"usernum","")).text = Dvbbs.CacheData(10,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"maxonline","")).text = Dvbbs.CacheData(5,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"maxpost","")).text = Dvbbs.CacheData(12,0) Node.attributes.setNamedItem(XMLDom.createNode(2,"uploadpath","")).text = Dvbbs.Forum_Setting(76) Node.attributes.setNamedItem(XMLDom.createNode(2,"forumversion","")).text = "8.1.0" If iUserID > 0 Then Set Rs=Dvbbs.Execute("Select UserID,UserName,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,IsChallenge,UserMobile,TitlePic,UserTitle,UserAnswer From Dv_User Where UserID = " & iUserID) If Not (Rs.Eof And Rs.Bof) Then Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"userencode","")) Node.attributes.setNamedItem(XMLDom.createNode(2,"encodestr","")).text = MD5(Rs("UserAnswer") & ":" & FormatDateTime(Rs("JoinDate"),2),32) SQL=RS.GetRows(1) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","userdatarows") For each node1 in node.documentElement.selectNodes("row") node1.selectSingleNode("@useranswer").text="加密字段" Next XMLDom.documentElement.appendChild(node.documentElement) End If End If SQL="Select Top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where isbest=1 order by topicid Desc" Set Rs=Dvbbs.Execute(SQL) SQL=RS.GetRows(-1) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","bestdatarows") For each node1 in node.documentElement.selectNodes("row") If node1.selectSingleNode("@hidename").text="1" Then node1.selectSingleNode("@postusername").text="匿名用户" End If Next XMLDom.documentElement.appendChild(node.documentElement) If IsSqlDataBase = 1 Then SQL="Select top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Boardid in ("& blist &") and Datediff(d,LastPostTime, " & SqlNowString & ") < 5 order by hits Desc" Else SQL="Select top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Boardid in("& blist &") and Datediff('d',LastPostTime, " & SqlNowString & ") < 5 order by hits Desc" End If Set Rs=Dvbbs.Execute(SQL) SQL=RS.GetRows(-1) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","hotdatarows") For each node1 in node.documentElement.selectNodes("row") If node1.selectSingleNode("@hidename").text="1" Then node1.selectSingleNode("@postusername").text="匿名用户" End If Next XMLDom.documentElement.appendChild(node.documentElement) SQL="Select Top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Not BoardID In (444,777) order by topicid Desc" Set Rs=Dvbbs.Execute(SQL) SQL=RS.GetRows(-1) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","newdatarows") For each node1 in node.documentElement.selectNodes("row") If node1.selectSingleNode("@hidename").text="1" Then node1.selectSingleNode("@postusername").text="匿名用户" End If Next XMLDom.documentElement.appendChild(node.documentElement) Rs.Close Set Rs=Nothing Response.Clear Select Case Session.CodePage Case 65001 Response.CharSet="utf-8" Response.Write ""&vbNewLine Case 936 Response.CharSet="gb2312" Response.Write ""&vbNewLine Case 950 Response.CharSet="big5" Response.Write ""&vbNewLine End Select Response.ContentType="text/xml" Response.Write XMLDom.documentElement.XML End Sub Sub GetForumPic() Dim Rs,Sql,node,node1,blist,ForumID blist=boardlists() Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDOM.appendChild(XMLDOM.createElement("forumpic")) SQL="Select Top 50 * From Dv_upfile Where f_BoardID in ("&blist&") and f_announceid<>'0' order by f_id Desc" Set Rs=Dvbbs.Execute(SQL) SQL=RS.GetRows(-1) Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows") XMLDom.documentElement.appendChild(node.documentElement) Rs.Close Set Rs=Nothing Response.Clear Select Case Session.CodePage Case 65001 Response.CharSet="utf-8" Response.Write ""&vbNewLine Case 936 Response.CharSet="gb2312" Response.Write ""&vbNewLine Case 950 Response.CharSet="big5" Response.Write ""&vbNewLine End Select Response.ContentType="text/xml" Response.Write XMLDom.documentElement.XML End Sub Function GetparentBoard(bid) Dim Node Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]/@parentid") If Not Node is Nothing Then If Node.text<>"0" Then If Not Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&Node.text&"]/@boardtype") Is Nothing Then GetparentBoard=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&Node.text&"]/@boardtype").text End If End If End If End Function Function checkoutbaord(bid) Dim Node Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]") If Not Node is Nothing Then If Node.selectSingleNode("@checkout").text="0" Then checkoutbaord=0 End If End If End Function Function GetBoardhidden(bid) Dim Node Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]") If Not Node is Nothing Then If Node.selectSingleNode("@hidden").text="0" Then GetBoardhidden=0 End If End If End Function Function Getbbsname(bid) Dim Node Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]/@boardtype") If Not Node is Nothing Then Getbbsname=Node.text End If End Function Function GetLastPostID() Dim Rs Set Rs=Dvbbs.Execute("Select Max(topicID) From Dv_topic") If IsNull(rs(0)) Then GetLastPostID=0 Else GetLastPostID=Rs(0) End If End Function Function IpInList() Ipinlist=False If not IsObject(Application(Dvbbs.CacheName & "_iplist")) Then SendData() ElseIf DateDiff("D",Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("@date").text,Date())<> 0 Then SendData() End If Dim ip,iparray ip=Request.ServerVariables("REMOTE_ADDR") iparray=split(ip,".") If UBound(iparray)=3 Then If Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&".*.*.*']") Is Nothing Then Ipinlist=True ElseIf Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&"."&iparray(1)&".*.*']") Is Nothing Then Ipinlist=True ElseIf Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&"."&iparray(1)&"."&iparray(2)&".*']") Is Nothing Then Ipinlist=True ElseIf Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&"."&iparray(1)&"."&iparray(2)&"."&iparray(3)&"']") Is Nothing Then Ipinlist=True End If End If End Function Function strAnsi2Unicode(asContents) Dim len1,i,varchar,varasc strAnsi2Unicode = "" len1=LenB(asContents) If len1=0 Then Exit Function For i=1 to len1 varchar=MidB(asContents,i,1) varasc=AscB(varchar) If varasc > 127 Then If MidB(asContents,i+1,1)<>"" Then strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar)) End If i=i+1 Else strAnsi2Unicode = strAnsi2Unicode & Chr(varasc) End If Next End Function Sub SendData() Dim xmlhttp,xml,DataToSend,xmlserverurl On Error Resume Next Set xmlhttp = Dvbbs.iCreateObject("MSXML2.ServerXMLHTTP"&MsxmlVersion) xmlserverurl="http://server.dvbbs.net/dvbbs/iplist.asp" xmlhttp.setTimeouts 65000, 65000, 65000, 65000 xmlhttp.Open "POST",xmlserverurl,false xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" xmlhttp.send Set XML=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If XML.loadxml(strAnsi2Unicode(xmlhttp.responseBody)) Then Xml.documentElement.selectSingleNode("@date").text=Date() Set Application(Dvbbs.CacheName & "_iplist")=Xml.cloneNode(true) End If Set xmlhttp = Nothing End Sub %>