?? searchadv.asp
字號:
TitleColumn = "ProductName"
sqlSearch = sqlSearch & SQLStr_5
LoopStr = "<tr>" & _
" <td align='right'></td>" & _
" <td width='100%'>【編號：{$infoid}】<a href='{$linkurl}' target='_blank'>{$prefixion}{$productname}</a></td>" & _
" <td align='center'> </td>" & _
"</tr>"
Case Else
ModuleName = "文章"
InfoTable = "Cl_Article"
TitleColumn = "Title"
sqlSearch = sqlSearch & SQLStr_1
LoopStr = "<tr>" & _
" <td align='right'></td>" & _
" <td width='100%'>【編號：{$infoid}】<a href='{$linkurl}' target='_blank'>{$prefixion}{$title}</a></td>" & _
" <td align='center'> </td>" & _
"</tr>"
End Select
tWhereStr = " Where Status=1 and Deleted="&FalseType&" " & Replace(WhereStr&"","{$TitleColumn}",TitleColumn)
'Response.write WhereStr
sqlSearch = sqlSearch & tWhereStr & " order by UpdateTime desc,InfoID Desc"
'Response.write sqlSearch
Set rsInfo = Server.CreateObject("adodb.recordset")
OpenConn : rsInfo.Open sqlSearch,Conn,1,1
if rsInfo.bof and rsInfo.eof then
TotalPut=0
HTMLStr = HTMLStr & "<div class=""border_title"">"
HTMLStr = HTMLStr & ""&ModuleName&"搜索結果（沒有任何符合條件的記錄）"
HTMLStr = HTMLStr & "</div>"
HTMLStr = HTMLStr & "<p align='center' style='font-size:18px;color:#ff0033'>沒有任何符合條件的記錄，請重新搜索！</p>"
rsInfo.Close : Set rsInfo=Nothing
Else
Dim rsTotalPut
Set rsTotalPut= Cl.Execute("Select Count(InfoID) from "&InfoTable&" " & tWhereStr)
TotalPut = rsTotalPut(0)
rsTotalPut.Close : Set rsTotalPut=Nothing
'TotalPut = rsInfo.recordcount
if (TotalPut mod PageSize)=0 then
TotalPages = TotalPut \ PageSize
else
TotalPages = TotalPut \ PageSize + 1
end if
if CurrentPage > TotalPages then CurrentPage=TotalPages
if CurrentPage < 2 then
CurrentPage=1
else
rsInfo.move (CurrentPage-1)*PageSize
end If
Set XMLData = Cl.RecordSetToXML(rsInfo,"info","infolist")
rsInfo.Close : Set rsInfo=Nothing
HTMLStr = HTMLStr & "<div class=""border_title"">"
HTMLStr = HTMLStr & ""&ModuleName&"搜索結果（共找到符合要求的"&ModuleName&" <span class='red b'>"&TotalPut&"</span> 條，當前第顯示前 <span class='red b'>"&NoModulePageSize&"</span> 條記錄）"
HTMLStr = HTMLStr & " <a href='"&FileName_2&"&ModuleID="&ii&"' class='red b'>查看全部>></a>"
HTMLStr = HTMLStr & "</div>"
HTMLStr = HTMLStr & ShowSearchAdvInfoList(XMLData,LoopStr)
HTMLStr = HTMLStr & "<hr align=""center"" width=""100%"" size=""1"" color=""#CCCCCC"" />"
sqlSearch = Empty
Set XMLData = Nothing
end If
Next
ShowSearchContent_0 = HTMLStr
End Function
Function ShowSearchContent()
If ModuleID = 0 Then
ShowSearchContent = ShowSearchContent_0
Exit Function
End if
Dim InfoTable,TitleColumn,XMLData,LoopStr
Dim sqlSearch,WhereStr,HTMLStr
sqlSearch = "select InfoID, ChannelID, ChannelDir, ClassID, Prefixion, "
Select Case ModuleID
Case 2
InfoTable = "Cl_Soft"
TitleColumn = "SoftName"
sqlSearch = sqlSearch & SQLStr_2
LoopStr = LoopStr_2
Case 3
InfoTable = "Cl_Photo"
TitleColumn = "PhotoName"
sqlSearch = sqlSearch & SQLStr_3
LoopStr = LoopStr_3
Case 4
InfoTable = "Cl_Movie"
TitleColumn = "MovieName"
sqlSearch = sqlSearch & SQLStr_4
LoopStr = LoopStr_4
Case 5
InfoTable = "Cl_Product"
TitleColumn = "ProductName"
sqlSearch = sqlSearch & SQLStr_5
LoopStr = LoopStr_5
Case Else
InfoTable = "Cl_Article"
TitleColumn = "Title"
sqlSearch = sqlSearch & SQLStr_1
LoopStr = LoopStr_1
End Select
if ChannelID>0 then WhereStr = WhereStr & " and ChannelID="&ChannelID&" "
if PointB>-1 then
if PointB > PointM then
WhereStr = WhereStr & " and InfoPoint>="&PointM&" and InfoPoint<="&PointB&" "
else
WhereStr = WhereStr & " and InfoPoint="&PointB&" "
end if
end if
if MoneyB>-1 then
if MoneyB > MoneyM then
WhereStr = WhereStr & " and InfoMoney>="&MoneyM&" and InfoMoney<="&MoneyB&" "
else
WhereStr = WhereStr & " and InfoMoney="&MoneyB&" "
end if
end if
if Elite=1 then WhereStr = WhereStr & " and Elite="&TrueType&" "
if Hot=1 then WhereStr = WhereStr & " and Hot="&TrueType&" "
if Dates>0 Then
If IsSQLDatabase = 1 then
WhereStr = WhereStr & " and Datediff(d,UpdateTime,getdate())<="&Dates&" "
Else
WhereStr = WhereStr & " and Datediff('d',UpdateTime,now())<="&Dates&" "
End if
End if
if Keyword<>"" and Keyword<>"輸入關鍵字" Then
Dim ArrKeyWord,Ki,Kn
Keyword = Cl.ReplaceBadChar(Keyword)
ArrKeyWord = Split(Keyword,";")
Kn = UBound(ArrKeyWord)
WhereStr = WhereStr & " and ("
Select Case Field
Case "Title"
WhereStr = WhereStr & " " & TitleColumn&" like '%" & ArrKeyWord(0) & "%' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or "&TitleColumn&" like '%" & ArrKeyWord(Ki) & "%' "
Next
End if
Case "Keyword"
WhereStr = WhereStr & " Keyword like '%" & ArrKeyWord(0) & "%' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or Keyword like '%" & ArrKeyWord(Ki) & "%' "
Next
End if
Case "Intro"
WhereStr = WhereStr & " Intro like '%" & ArrKeyWord(0) & "%' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or Intro like '%" & ArrKeyWord(Ki) & "%' "
Next
End if
Case "CopyFrom"
WhereStr = WhereStr & " Author like '%" & ArrKeyWord(0) & "%' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or Author like '%" & ArrKeyWord(Ki) & "%' "
Next
End if
Case "Editor"
WhereStr = WhereStr & " Editor='" & ArrKeyWord(0) & "' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or Editor='" & ArrKeyWord(Ki) & "' "
Next
End if
Case "Censor"
WhereStr = WhereStr & " Censor='" & ArrKeyWord(0) & "' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or Censor='" & ArrKeyWord(Ki) & "' "
Next
End if
Case Else
WhereStr = WhereStr & " "&TitleColumn&" like '%" & ArrKeyWord(0) & "%' "
If Kn > 0 Then
For Ki=1 To Kn
WhereStr = WhereStr & " Or "&TitleColumn&" like '%" & ArrKeyWord(Ki) & "%' "
Next
End if
End Select
WhereStr = WhereStr & ")"
End if
if WhereStr="" then Call Cl.OutMsg(0,"請輸入搜索關鍵字或者選擇搜索參數！","-1")
Rem 對搜索時間進行判斷
If Request("IsSearch") = "yes" and IsDate(Session("SearchTime")) Then
If DateDiff("S",Session("SearchTime"),Now()) < SearchWaitTime Then
Call Cl.OutErr(0,"請休息60秒后再使用此功能！")
End if
End If
Session("SearchTime") = Now()
Rem End
WhereStr = " Where Status=1 and Deleted="&FalseType&" " & WhereStr
'Response.write WhereStr
sqlSearch = sqlSearch & WhereStr & " order by UpdateTime desc,InfoID Desc"
'Response.write sqlSearch
Set rsInfo = Server.CreateObject("adodb.recordset")
OpenConn : rsInfo.Open sqlSearch,Conn,1,1
if rsInfo.bof and rsInfo.eof then
TotalPut=0
HTMLStr = HTMLStr & "<p align='center' style='font-size:18px;color:#ff0033'>沒有任何符合條件的記錄，請重新搜索！</p>"
rsInfo.Close : Set rsInfo=Nothing
Else
Dim rsTotalPut
Set rsTotalPut= Cl.Execute("Select Count(InfoID) from "&InfoTable&" " & WhereStr)
TotalPut = rsTotalPut(0)
rsTotalPut.Close : Set rsTotalPut=Nothing
'TotalPut = rsInfo.recordcount
if (TotalPut mod PageSize)=0 then
TotalPages = TotalPut \ PageSize
else
TotalPages = TotalPut \ PageSize + 1
end if
if CurrentPage > TotalPages then CurrentPage=TotalPages
if CurrentPage < 2 then
CurrentPage=1
else
rsInfo.move (CurrentPage-1)*PageSize
end If
Set XMLData = Cl.ArrayToXML(rsInfo.GetRows(PageSize),rsInfo,"info","infolist")
rsInfo.Close : Set rsInfo=Nothing
HTMLStr = HTMLStr & "<div class=""border_title"">"
HTMLStr = HTMLStr & "搜索結果（共找到符合要求的記錄 <span class='red b'>"&TotalPut&"</span> 條，每頁顯示 <span class='red b'>"&PageSize&"</span> 條，共 <span class='red b'>"&TotalPages&"</span> 頁，當前第 <span class='red b'>"&CurrentPage&"</span> 頁）"
HTMLStr = HTMLStr & "</div>"
Dim ShowPageStr
ShowPageStr = Cl.ShowPage(FileName,TotalPut,PageSize,"條","資料")
HTMLStr = HTMLStr & ShowPageStr
HTMLStr = HTMLStr & "<hr align=""center"" width=""100%"" size=""1"" color=""#CCCCCC"" />"
HTMLStr = HTMLStr & ShowSearchAdvInfoList(XMLData,LoopStr)
HTMLStr = HTMLStr & "<hr align=""center"" width=""100%"" size=""1"" color=""#CCCCCC"" />"
HTMLStr = HTMLStr & ShowPageStr
sqlSearch = Empty
Set XMLData = Nothing
end If
ShowSearchContent = HTMLStr
End Function
Function ShowSearchAdvInfoList(ByVal XMLData, ByVal LoopStr)
Dim Node,LinkURL,TempLoopHTML,HTMLStr
Dim regEx,Matches,Match,ArrayStr,DataStr
Set regEx = New RegExp
regEx.IgnoreCase= True
regEx.Global = True
regEx.Pattern = "{\$.[^{\$}]*}"
HTMLStr = "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' style='word-break:break-all'>"
For Each Node In XMLData.DocumentElement.SelectNodes("info")
TempLoopHTML = LoopStr
Set Matches = regEx.Execute(TempLoopHTML)
For Each Match in Matches
ArrayStr = Match.Value
ArrayStr = Replace(ArrayStr,"{$","")
ArrayStr = Replace(ArrayStr,"}","")
ArrayStr = Replace(ArrayStr,"(",",")
ArrayStr = Replace(ArrayStr,")","")
ArrayStr = Split(ArrayStr,",")
Select Case LCase(ArrayStr(0))
Case "linkurl"
if CBool(Node.SelectSingleNode("@ishtml").text) = True then
DataStr = InstallDir & Node.SelectSingleNode("@htmlfileurl").text
else
DataStr = InstallDir & Node.SelectSingleNode("@channeldir").text & "/ShowInfo.asp?InfoID=" & Node.SelectSingleNode("@infoid").text
end if
Case "classurl" : DataStr = Cl.GetClassLinkUrl(Node.SelectSingleNode("@classid").text)
Case "classname" : DataStr = Cl.GetClassName(Node.SelectSingleNode("@classid").text)
Case "title","softname","photoname","moviename","productname"
DataStr = Node.SelectSingleNode("@" & ArrayStr(0)).text
If Field = "Title" Then
DataStr = Replace(DataStr,KeyWord,"<font color='red'>" & KeyWord & "</font>")
End if
Case "intro"
DataStr = Server.HTMLEnCode(Left(Cl.NoHTML(Node.SelectSingleNode("@intro").text&""),ArrayStr(1)))
If Field = "Intro" Then
DataStr = Replace(DataStr,KeyWord,"<font color='red'>" & KeyWord & "</font")
End if
Case "updatetime"
DataStr = Node.SelectSingleNode("@updatetime").text
Case Else
'Response.write ArrayStr(0) & "<br />"
DataStr = Node.SelectSingleNode("@"&ArrayStr(0)).text
End Select
TempLoopHTML = Replace(TempLoopHTML,Match.Value,DataStr)
Next
Set Match = Nothing
Set Matches = Nothing
HTMLStr = HTMLStr & TempLoopHTML
Next
HTMLStr = HTMLStr & "</table>"
DataStr = Empty
ArrayStr = Empty
Set regEx = Nothing
ShowSearchAdvInfoList = HTMLStr
End Function
Function CreateChannelOptionJs(FirstChannelID,FirstClassID,ChannelObj,ClassObj)
Dim Node,CNode,i,ii,JsStr
JsStr = "<script type=""text/javascript"">" & VbCrlf
JsStr = JsStr & "var ChannelObj=document.getElementById("""&ChannelObj&""");" & VbCrlf
JsStr = JsStr & "var Class_Option=new Array();" & VbCrlf
ii=0
For Each Node In Application(Cl.CacheName&"_channellist").documentElement.SelectNodes("channel[@isshow=1][@isdisabled=0][@channeltype<2][@channelid>0]")
JsStr = JsStr & "ChannelObj.options[ChannelObj.length] = new Option("""&Node.SelectSingleNode("@channelname").text&""", """&Node.SelectSingleNode("@channelid").text&""");" & VbCrlf
For Each CNode In Application(Cl.CacheName&"_classlist").documentElement.SelectNodes("class[@channelid="&Node.SelectSingleNode("@channelid").text&"][@depth=0]")
JsStr = JsStr & "Class_Option["&ii&"]=Array("""&Node.SelectSingleNode("@channelid").text&""","""&CNode.SelectSingleNode("@classid").text&""","""&CNode.SelectSingleNode("@classname").text&""");" & VbCrlf
ii=ii+1
Next
Set CNode=Nothing
Next
Set Node=Nothing
JsStr = JsStr & "function ChangeChannel(Channelid,objname)" & VbCrlf
JsStr = JsStr & "{" & VbCrlf
JsStr = JsStr & " var obj=document.getElementById(objname);" & VbCrlf
JsStr = JsStr & " var i;j=obj.length;" & VbCrlf
JsStr = JsStr & " for (i=0;i<j;i++)" & VbCrlf
JsStr = JsStr & " {" & VbCrlf
JsStr = JsStr & " obj.options[j-i]=null;" & VbCrlf
JsStr = JsStr & " }" & VbCrlf
JsStr = JsStr & " j=Class_Option.length" & VbCrlf
JsStr = JsStr & " for (i=0;i<j;i++)" & VbCrlf
JsStr = JsStr & " {" & VbCrlf
JsStr = JsStr & " if (Class_Option[i][0] == Channelid)" & VbCrlf
JsStr = JsStr & " {" & VbCrlf
JsStr = JsStr & " obj.options[obj.length] = new Option(Class_Option[i][2], Class_Option[i][1]);" & VbCrlf
JsStr = JsStr & " }" & VbCrlf
JsStr = JsStr & " }" & VbCrlf
JsStr = JsStr & "}" & VbCrlf
JsStr = JsStr & "CheckSel("""&ChannelObj&""","""&FirstChannelID&""");" & VbCrlf
JsStr = JsStr & "ChangeChannel("""&FirstChannelID&""","""&ClassObj&""");" & VbCrlf
JsStr = JsStr & "</script>"
CreateChannelOptionJs = JsStr
End Function
%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -