searchadv.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

			InfoTable	= "Cl_Product"
			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'>&nbsp;</td>" & _
	"</tr>"
		Case 6
			ModuleName = "信息"
			InfoTable	= "Cl_Supply"
			TitleColumn	= "Title"
			sqlSearch	= sqlSearch & SQLStr_6
			LoopStr		= "<tr>" & _
	"	<td align='right'></td>" & _
	"	<td width='100%'>【编号：{$infoid}】<a href='{$linkurl}' target='_blank'>{$prefixion}{$title}</a></td>" & _
	"	<td align='center'>&nbsp;</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'>&nbsp;</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 & "&nbsp;&nbsp;&nbsp;<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 6
		InfoTable	= "Cl_Supply"
		TitleColumn	= "Title"
		sqlSearch	= sqlSearch & SQLStr_6
		LoopStr		= LoopStr_6
	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
%>