query.asp

现在好了

				If IsSqlDataBase Then
				If Trim(searchboard)="" And Trim(searchday)="" Then
					SqlColumn = SqlColumn & stable & " T1 Inner Join ContainsTable("&stable&",body,'" & keyword & "'," & Dvbbs.Forum_Setting(11)*SearchMaxPageList & ") As T2 ON T1.AnnounceID = T2.[KEY] Order By T1.AnnounceID Desc"
				ElseIf Trim(searchboard)="" Then
					SqlColumn = SqlColumn & stable & " T1 Inner Join ContainsTable("&stable&",body,'" & keyword & "'," & Dvbbs.Forum_Setting(11)*SearchMaxPageList & ") As T2 ON T1.AnnounceID = T2.[KEY] Where  "&Replace(Replace(searchday,"and",""),"DateAndTime","T1.DateAndTime")&" Order By T1.AnnounceID Desc"
				ElseIf Trim(searchday)="" Then
					SqlColumn = SqlColumn & stable & " T1 Inner Join ContainsTable("&stable&",body,'" & keyword & "'," & Dvbbs.Forum_Setting(11)*SearchMaxPageList & ") As T2 ON T1.AnnounceID = T2.[KEY] Where "&Replace(Replace(searchboard,"and",""),"BoardID","T1.BoardID")&" Order By T1.AnnounceID Desc"
				Else
					SqlColumn = SqlColumn & stable & " T1 Inner Join ContainsTable("&stable&",body,'" & keyword & "'," & Dvbbs.Forum_Setting(11)*SearchMaxPageList & ") As T2 ON T1.AnnounceID = T2.[KEY] Where "&Replace(searchboard,"BoardID","T1.BoardID")&" "&Replace(Replace(searchday,"and",""),"DateAndTime","T1.DateAndTime")&" Order By T1.AnnounceID Desc"
				End If
				Else
				SqlColumn = SqlColumn & stable & " Where "&searchboard&" "&searchday&" body like '%"&keyword&"%' Order By AnnounceID Desc"
				End If
				Dvbbs.Stats = Dvbbs.Stats & template.Strings(11)
			Else
				 Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(19)&"&action=OtherErr"
			End If
		End Select
	'最新50贴
	Case 3
		If Dvbbs.BoardID > 0 then
			SqlColumn = SqlColumn &" "&stable&" where BoardID="&trim(request("BoardID"))&" ORDER BY announceID desc"
		Else
			SqlColumn = SqlColumn &" "&stable&" ORDER BY announceID desc"
		End if
		Dvbbs.Stats = template.Strings(12)
	Case 4
		If keyword<>"" Then
			Set Rs=Dvbbs.Execute("Select UserID From Dv_User Where UserName='"&keyword&"'")
			If Rs.Eof And Rs.Bof Then
				Set Rs=Nothing
				Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(21)&"&action=OtherErr"
			Else
				SearchUserID = Rs(0)
			End If
		End If
		Dim HotTopicDay,HotTopicView,MyHotTopic
		If Dvbbs.Forum_Setting(13)<>"0" Then
			MyHotTopic = Split(Dvbbs.Forum_Setting(13),"|")
			If Ubound(MyHotTopic)=1 Then
				HotTopicDay = MyHotTopic(0)
				HotTopicView = MyHotTopic(1)
			Else
				HotTopicDay = 10
				HotTopicView = 200
			End If
		Else
			HotTopicDay = 10
			HotTopicView = 200
		End If
		Dvbbs.Stats = Replace(Replace(template.Strings(13),"{$daylimited}",HotTopicDay),"{$viewlimited}",HotTopicView)
		If IsSqlDataBase=1 Then
			searchday=" datediff(d,DateAndTime,"&SqlNowString&") < "&HotTopicDay&" and "
		Else
			searchday=" datediff('d',DateAndTime,"&SqlNowString&") < "&HotTopicDay&" and "
		End If
		If keyword<>"" Then keyword = " And PostUserID="&SearchUserID
		SqlColumn = SqlColumn & " dv_Topic Where "&searchday&" hits>"&HotTopicView&" "&keyword&" Order By TopicID Desc"
	Case 5
		If Dvbbs.UserID=0 Then
			Dvbbs.AddErrCode(61)
			Exit Sub
		End If
		Dim s
		s=request("s")
		If s="" Or Not IsNumerIc(s) Then s=1
		s=clng(s)
		If s=1 Then
			SqlColumn=LCase("select BoardID,TopicID as rootid,Title as topic,Expression,PostUserName as UserName,PostUserID,DateAndtime,IsBest,LockTopic from Dv_Topic where Boardid<>444 And topicid in (select top 200 rootid from "&stable&" where ParentID>0 And PostUserID="&Dvbbs.UserID&" order by AnnounceID desc) order by topicid desc")
			Dvbbs.Stats = template.Strings(14)
		Else
			SqlColumn=LCase("select BoardID,TopicID as rootid ,Title as topic,Expression,PostUserName as UserName,PostUserID,DateAndtime,IsBest,LockTopic from dv_topic where Boardid<>444 And postUserID="&Dvbbs.UserID&" ORDER BY topicid desc")
			Dvbbs.Stats = template.Strings(15)
		End If
	Case 6
		If keyword<>"" Then
			Set Rs=Dvbbs.Execute("Select UserID From Dv_User Where UserName='"&keyword&"'")
			If Rs.Eof And Rs.Bof Then
				Set Rs=Nothing
				Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(21)&"&action=OtherErr"
			Else
				SearchUserID = Rs(0)
			End If
		End If
		If Trim(searchboard)="" Then
			If keyword<>"" Then
				keyword = " Where PostUserID="&SearchUserID
			End If
			SqlColumn = LCase("select BoardID,RootID,Title as topic ,Expression,PostUserName as username,PostUserID,DateAndtime,PostUserID As IsBest,PostUserID As LockTopic From dv_BestTopic ")& keyword&" Order By ID Desc"
			Else
			If keyword<>"" Then
				keyword = " And PostUserID="&SearchUserID
			End If
			SqlColumn = LCase("select BoardID,RootID,Title as topic,Expression,PostUserName as username ,PostUserID,DateAndtime,PostUserID As IsBest,PostUserID As LockTopic From dv_BestTopic Where ") & Replace(searchboard,"and","")&" "&keyword&" Order By ID Desc"
		End If
		Dvbbs.Stats = template.Strings(16)
	Case Else
		Dvbbs.AddErrCode(61)
		Exit Sub
	End Select

	Dvbbs.Nav()
	If Dvbbs.BoardID=0 then
		Dvbbs.Head_var 0,0,template.Strings(0),"query.asp"
	Else
		Dvbbs.Head_var 1,Dvbbs.BoardNode.attributes.getNamedItem("depth").text,"",""
	End If
	If IsEmpty(Session("QueryLimited")) Then
		Session("QueryLimited") = keyword & "|" & stype & "|" & Now()
	Else
		Dim QueryLimited
		QueryLimited = Split(Session("QueryLimited"),"|")
		If Ubound(QueryLimited) = 2 Then
			If Cstr(Trim(QueryLimited(0))) = Cstr(keyword) And Cstr(Trim(QueryLimited(1))) = Cstr(stype) Then
				Session("QueryLimited") = keyword & "|" & stype & "|" & Now()
			Else
				If DateDiff("s",QueryLimited(2),Now()) < Clng(Dvbbs.Forum_Setting(3)) And Not(Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then
					Response.redirect "showerr.asp?ErrCodes=<li>"&Replace(template.Strings(20),"{$timelimited}",Dvbbs.Forum_Setting(3))&"&action=OtherErr"
				Else
					Session("QueryLimited") = keyword & "|" & stype & "|" & Now()
				End If
			End If
		Else
			Session("QueryLimited") = keyword & "|" & stype & "|" & Now()
		End If
	End If
End Sub
Sub SearchResult()
	Dim Rs
	Dim Record_Count,n,sql
	SQLQueryStr()
	If Dvbbs.ErrCodes<>"" Then Exit Sub
	If Not IsObject(Conn) Then ConnectionDatabase
	Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1
	Set Rs=server.createobject("adodb.recordset")
	'Response.Write SqlColumn
	Rs.Open SqlColumn,Conn,1,1
	If Err Then
		Dvbbs.AddErrCode(61)
		Exit Sub
	Else
		If Not Rs.Eof Then
			Record_Count = Rs.RecordCount
			If Record_Count Mod Cint(Dvbbs.Forum_Setting(11))=0 Then
				n = Record_Count \ Cint(Dvbbs.Forum_Setting(11))
			Else
				n = Record_Count \ Cint(Dvbbs.Forum_Setting(11))+1
			End If
			Rs.MoveFirst
			If page > n Then page = n
			If page < 1 Then page = 1
			If page > 1 Then 				
				Rs.Move (page-1) * Clng(Dvbbs.Forum_Setting(11))
			End if
			Sql = Rs.GetRows(Clng(Dvbbs.Forum_Setting(11)))
		Else
			Dvbbs.AddErrCode(32)
			Exit Sub
		End If
	End If
	Rs.Close:Set Rs=Nothing
	RectoXMl(Sql)
	Dim SearchStr
	SearchStr = "stype="& Request("stype") &"&pSearch="& Request("pSearch")&"&nSearch=" & Request("nSearch") &"&boardid="&Request("boardid")&"&SearchDate="& Request("SearchDate")&"&keyword=" &Server.urlencode(Request("keyword"))&"&s="&Request("s")

	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"pagecount","")).text=Record_Count
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"loginhidden","")).text=Dvbbs.GroupSetting(37)
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"page","")).text=page
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"action","")).text=action
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"pagesize","")).text=Dvbbs.Forum_Setting(11)
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"PageStr","")).text=SearchStr
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"boardid","")).text=Dvbbs.boardid
	Dim BoardXML
	ConvertBoard BoardXML
	XMLDOM.documentElement.appendChild(BoardXML.documentElement)
	Set BoardXML=Nothing
	DoShowHTML()
End Sub
'整理干净XML的过程 By 老迷
Sub RectoXMl(Rs)
	Dim RsXML
	Dim i,j,node,Columns,attributes,FirstNode
	Set RsXML=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
	'Rs.Save RsXML,1

	If Ubound(Rs,1)=10 Then
		Columns = "boardid,rootid,topic,expression,username,postuserid,dateandtime,isbest,locktopic,body,announceid"
	ElseIf Ubound(Rs,1)=8 Then
		Columns = "boardid,rootid,topic,expression,username,postuserid,dateandtime,isbest,locktopic"
	End If
	Columns = Split(Columns,",")
	RsXML.loadxml "<?xml version=""1.0"" encoding=""gb2312""?><xml/>"
	Set FirstNode = RsXML.createNode(1,"rsdata","")
	For i=0 to Ubound(Rs,2)
		Set node=RsXML.createNode(1,"zrow","")
		For j = 0 to Ubound(Columns)
			Set attributes=RsXML.createAttribute(Columns(j))
			If j = 9 Then
				attributes.text = Left(Rs(j,i)&"",30)
			Else
				attributes.text = Rs(j,i)
			End If
			node.attributes.setNamedItem(attributes)
		Next
		FirstNode.appendChild(node)
	Next
	RsXML.documentElement.appendChild(FirstNode)
	'RsXML.save server.MapPath("query1.xml")
	'Response.End
	Dim XSLTemplate,stylesheet,proc
	If Not IsObject(Application(Dvbbs.CacheName&"_RectoXMl")) Then
		Set stylesheet=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
		stylesheet.load server.MapPath("inc/RectoXMl.xslt")
		Set XSLTemplate=Server.CreateObject("Msxml2.XSLTemplate")
		XSLTemplate.stylesheet=stylesheet
		Set Application(Dvbbs.CacheName&"_RectoXMl")=XSLTemplate
	Else
		Set XSLTemplate=Application(Dvbbs.CacheName&"_RectoXMl")
	End If
	Set proc = XSLTemplate.createProcessor()
	proc.input = RsXML
	proc.transform()
	Set XMLDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
	XMLDOM.loadXML proc.output
End Sub
'转换版面层次 By 老迷
Sub ConvertBoard(BoardXML)
	If Not IsObject(Application(Dvbbs.CacheName&"_sBoradlist1")) Then
		Set BoardXML=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
		Dim XSLTemplate,stylesheet,proc
		If Not IsObject(Application(Dvbbs.CacheName&"_ConvertBoard")) Then
			Set stylesheet=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
			stylesheet.load server.MapPath("inc/ConvertBoard.xslt")
			Set XSLTemplate=Server.CreateObject("Msxml2.XSLTemplate")
			XSLTemplate.stylesheet=stylesheet
			Set Application(Dvbbs.CacheName&"_ConvertBoard")=XSLTemplate
		Else
			Set XSLTemplate=Application(Dvbbs.CacheName&"_ConvertBoard")
		End If
		Set proc = XSLTemplate.createProcessor()
		proc.input = Application(Dvbbs.CacheName&"_sBoradlist")
		proc.transform()
		BoardXML.loadXML proc.output
		Set Application(Dvbbs.CacheName&"_sBoradlist1")=BoardXML.cloneNode(True)
	Else
		Set BoardXML=Application(Dvbbs.CacheName&"_sBoradlist1").cloneNode(True)
	End If
End Sub
%>