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 %>