www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\ask\search.asp

    <!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/cls_keyword.asp"-->
<%
Dim HtmlContent,XMLDom,HeadTitle,DetailedPage,strLink
Dim maxperpage,CurrentPage,Pcount,totalrec,totalnumber
Dim maxlistnum,SearchMaxPageList,m_strLinks
Dim topicmode,Keyword,LikeKeyword,searchmode
maxperpage = 20
maxlistnum = 500
searchmode = 0
CurrentPage		= NewAsp.ChkNumeric(Request("page"))
If CurrentPage = 0 Then CurrentPage = 1
Keyword = Trim(Request("q"))
If Len(Keyword) = 0 Then Keyword = Trim(Request("word"))
If Len(Keyword) = 0 Then Keyword = Trim(Request("wd"))

HeadTitle = Keyword
HeadTitle = NewAsp.HTMLEncode(HeadTitle)
HtmlContent = NewAsp.LoadTemplate("search")
HtmlContent = Replace(HtmlContent, "{$HeadTitle}", "问吧搜索_"& HeadTitle)
HtmlContent = Replace(HtmlContent, "{$Current}", "问吧搜索--"& HeadTitle)
HtmlContent = Replace(HtmlContent, "{$Keyword}", HeadTitle)
HtmlContent = Replace(HtmlContent, "{$ClassID}", 0)

appendSearchform()
SearchResult()

Response.Write NewAsp.ArchiveHtml(HtmlContent)

NewAsp.CloseConn()

Sub appendSearchform()
	If Not IsObject(Application(NewAsp.CacheName&"_Searchform")) Then
		Set XMLDom = NewAsp.CreateXMLDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		XMLDom.appendChild(XMLDom.createElement("xml"))
		XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"keywordminlen","")).text=2
		XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"keywordmaxlen","")).text=30
		XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"timelimited","")).text=2
		Dim Rs,Node
		Set Rs=NewAsp.Execute("SELECT id,TableName,TableType FROM NC_Ask_TableList")
		Do while Not Rs.Eof
			Set Node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"tablelist",""))
			Node.text=Rs("TableName")&""
			Node.attributes.setNamedItem(XMLDOM.createNode(2,"type","")).text=""&Rs("TableType")
			Rs.MoveNext
		Loop
		Set Rs=Nothing
		Set Application(NewAsp.CacheName&"_Searchform")=XMLDOM.cloneNode(True)
	Else
		Set XMLDOM=Application(NewAsp.CacheName&"_Searchform").cloneNode(True)	
	End If
	XMLDom.documentElement.setAttribute "topicmode",0
	XMLDom.documentElement.setAttribute "headtitle",HeadTitle
	XMLDom.documentElement.setAttribute "keyword",HeadTitle
	XMLDom.documentElement.setAttribute "searchmode",searchmode
End Sub

Sub SearchResult()
	Dim Rs,SQL,FoundSQL,topiclist,node
	Dim KeywordArray,KeywordLike,i,n
	'搜索返回结果数控制
	If maxlistnum > 0 Then
		If Clng(maxlistnum) Mod Cint(maxperpage)=0 Then
			SearchMaxPageList = Clng(maxlistnum) \ Cint(maxperpage)
		Else
			SearchMaxPageList = Clng(maxlistnum) \ Cint(maxperpage)+1
		End If
	Else
		SearchMaxPageList = 50
	End If
	SearchMaxPageList = CLng(SearchMaxPageList * maxperpage)
	If searchmode = 0 Then
		KeywordArray = ws.ParseKeyword(Keyword)
		n = 0
		FoundSQL = ""
		For i = 0 To UBound(KeywordArray)
			If Len(KeywordArray(i)) > 1 Then
				If n = 0 Then
					If IsSqlDataBase=1 Then
						FoundSQL = "title like '%"&KeywordArray(i)&"%'"
					Else
						FoundSQL = "InStr(1,LCase(Title),LCase('"&KeywordArray(i)&"'),0)>0"
					End If
				Else
					If IsSqlDataBase=1 Then
						FoundSQL = FoundSQL & " Or title like '%"&KeywordArray(i)&"%'"
					Else
						FoundSQL = FoundSQL & " Or InStr(1,LCase(Title),LCase('"&KeywordArray(i)&"'),0)>0"
					End If
				End If
				n = n + 1
			End If
		Next
		If n = 0 Then
			HtmlContent = Replace(HtmlContent, "{$Topiclist}", "错误的系统参数--请输入正确的搜索关键字")
			Exit Sub
		End If
	Else
		If ws.CheckKeyword(Keyword) Then
			If IsSqlDataBase=1 Then
				FoundSQL = "title like '%"&Keyword&"%'"
			Else
				FoundSQL = "InStr(1,LCase(Title),LCase('"&Keyword&"'),0)>0"
			End If
		Else
			HtmlContent = Replace(HtmlContent, "{$Topiclist}", "错误的系统参数--请输入正确的搜索关键字")
			Exit Sub
		End If
	End If
	FoundSQL = "And ("&FoundSQL&")"
	
	If Not IsObject(Conn) Then ConnectionDatabase
	Set Rs = NewAsp.CreateAXObject("ADODB.Recordset")
	SQL="SELECT TOP " & SearchMaxPageList & " TopicID,classid,userid,classname,title,PostUsername,Expired,Closed,PostTable,DateAndTime,LastPostTime,LockTopic,Reward,Hits,PostNum,CommentNum,TopicMode,Highlight,Broadcast,Anonymous,IsTop FROM NC_Ask_Topic WHERE LockTopic=0 " & FoundSQL & " ORDER BY LastPostTime DESC"
	Rs.Open SQL,Conn,1,1
	If Not (Rs.BOF And Rs.EOF) Then
		totalrec = CLng(Rs.recordcount) '###记录总数
		Pcount = CLng(totalrec / maxperpage)  '得到总页数
		If Pcount < totalrec / maxperpage Then Pcount = Pcount + 1
		If Pcount < 1 Then Pcount = 1
		If CurrentPage < 1 Then CurrentPage = 1
		If CurrentPage > Pcount Then CurrentPage = Pcount
		If CurrentPage >1 Then
			Rs.Move (CurrentPage-1) * maxperpage
		End If
	End If
	If Not Rs.EOF Then
		SQL=Rs.GetRows(maxperpage)
		Set topiclist=NewAsp.ArrayToxml(SQL,Rs,"row","topic")
	Else
		Set topiclist=Nothing
	End If
	Rs.Close : Set Rs=Nothing
	SQL=Empty
	XMLDom.documentElement.setAttribute "pagesize",maxperpage
	XMLDom.documentElement.setAttribute "page",CurrentPage
	XMLDom.documentElement.setAttribute "totalnumber",totalrec
	XMLDom.documentElement.setAttribute "totalrec",totalrec
	XMLDom.documentElement.setAttribute "pagecount",Pcount
	If Not topiclist Is Nothing Then 
		For Each Node in topiclist.documentElement.SelectNodes("row")
			Node.selectSingleNode("@title").text=NewAsp.Checkstr(Node.selectSingleNode("@title").text)
			Node.selectSingleNode("@dateandtime").text=NewAsp.FormatDate(Node.selectSingleNode("@dateandtime").text,5)
			If CLng(Node.selectSingleNode("@closed").text) = 1 Then
				Node.selectSingleNode("@topicmode").text=5
			End If
			If CLng(Node.selectSingleNode("@topicmode").text) = 3 Then
				m_strLinks=NewAsp.InstallDir&"share.asp?topicid="&Node.selectSingleNode("@topicid").text
			Else
				m_strLinks=NewAsp.InstallDir&"question.asp?topicid="&Node.selectSingleNode("@topicid").text
			End If
			Node.attributes.setNamedItem(topiclist.createNode(2,"link","")).text=m_strLinks
		Next
		XMLDom.documentElement.appendChild(topiclist.documentElement)
		Set topiclist=Nothing
	End If
	strLink = NewAsp.InstallDir & "search.asp?word="& Server.URLEncode(Keyword) &"&"
	DetailedPage = showlistpage(CurrentPage,Pcount,strLink)
	transformSearchlist()
End Sub

Sub transformSearchlist()
	Dim proc,XMLStyle,node,cnode,XSLTemplate
	Set XSLTemplate=NewAsp.CreateAXObject("Msxml2.XSLTemplate" & MsxmlVersion )
	Set XMLStyle=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion )
	If XMLStyle.load(Server.MapPath(NewAsp.TemplatePath & "xslt/search.xslt")) Then
		Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform")
		Set CNode=XMLStyle.createNode(2,"name","")
		CNode.text="installdir"
		Node.attributes.setNamedItem(CNode)
		Node.text=NewAsp.InstallDir
		XMLStyle.documentElement.appendChild(node)
		Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform")
		Set CNode=XMLStyle.createNode(2,"name","")
		CNode.text="DetailedPage"
		Node.attributes.setNamedItem(CNode)
		Node.text=DetailedPage
		XMLStyle.documentElement.appendChild(node)
		Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform")
		Set CNode=XMLStyle.createNode(2,"name","")
		CNode.text="skinurl"
		Node.attributes.setNamedItem(CNode)
		node.text=NewAsp.AskedSkinUrl
		XMLStyle.documentElement.appendChild(node)
		XSLTemplate.stylesheet=XMLStyle
		Set proc = XSLTemplate.createProcessor()
		proc.input = XMLDom
		proc.transform()
		Dim procstr
		procstr = proc.output
		Set proc=Nothing
	End If
	HtmlContent = Replace(HtmlContent, "{$Topiclist}", procstr)
	Set XMLDom=Nothing 
	Set XMLStyle=Nothing
	Set XSLTemplate=Nothing
End Sub
%>