functionitem.asp

一款类似百度知道系统的问题解答系统

<!--#include file="Channel_Config.asp"-->
<%
if Isdisabled=false then
response.redirect ""&cityurl&"/Include/error.asp?err=本频道已被管理员禁用！"
end if
%>
<%
if Isdisabled=false then
response.write "<font color=red>对不起，本频道已被管理员禁用！</span>"
else
'*************************
'功能：分页
'修正了在搜索中不能正确分页的BUG...
'*************************
function funpage(Intpagecount,Intmypage,Intrecordcount,Intpagesize)
	 on error resume next
	 dim Intfor,Intlist,intlist_b
	 Dim query, a, x, temp
    action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
    query = Split(Request.ServerVariables("QUERY_STRING"), "&")
    For Each x In query
     a = Split(x, "=")
     If StrComp(a(0), "page", vbTextCompare) <> 0 Then
     temp = temp & a(0) & "=" & a(1) & "&"
     End If
    Next  
	 if intmypage>1 then
		 funpage=funpage & "<a href='"&action&"?"&temp&"page=1' title='最前页' class='no'><font face='Webdings'>9</font></a>"
		 funpage=funpage&"<a href='"&action&"?"&temp&"page="&Intmypage-1 & "' title='上一页' class='no'><font face='Webdings'>7</font></a>"
	 else
		 funpage=funpage &"<font face='Webdings'>9</font>"
	 	 funpage=funpage&"<font face='Webdings'>7</font>"
	 end if
	 if Intlist<>0 then
		 if cintmypage= Intlist then
			Intlist=Intlist+5		
		 end if
	  else
	  	Intlist=Intmypage+5
	  end if
	  if intlist-9<1 then
	     intlist_b=1
	  else
	  	 intlist_b=intlist-9
	  end if		
	  for Intfor=intlist_b to Intlist          
	 	 if intfor<=Intpagecount then              
		 	 if intfor=Intmypage then       '-------使当前页文字为红色，并不可点击
				 funpage =funpage & strMode&" <font color='#FF0000'><b>"& Intfor & "</b></font>"
			 else
				 funpage=funpage & strMode &" <a href='"&action&"?"&temp&"page=" & Intfor &"' class='no'>" & Intfor & "</a>"
			 end if
		 end if
		 strMode=" <font color='#BBBBBB'>|</font> "
	  next
	  if intmypage<intpagecount then
	  	funpage=funpage&" <a href='"&action&"?"&temp&"page="& Intmypage+1 &"' title='后一页' class='no'><font face='Webdings'>8</font></a>"
	    funpage=funpage &"<a href='"&action&"?"&temp&"page="& Intpagecount & "' title='最后页' class='no'><font face='Webdings'>:</font></a>"
	  else
	  	funpage=funpage&" <font face='Webdings'>8</font>"	
	    funpage=funpage &"<font face='Webdings'>:</font></a>"
	  end if
	  funpage="<table width='100%' border='0' cellspacing='0' cellpadding='0'><tr>"&_ 
				vbcrlf&"<td width='40%'>&nbsp;当前第"&Intmypage&"页 　"&Intpagesize&"条/页 　共"&Intpagecount&"页/"&Intrecordcount&"条</td>"&_
				vbcrlf&"<td width='60%' align='right'>"&_
				vbcrlf&"<table width='360' border='0' cellspacing='0' cellpadding='0'><tr>"&_
				vbcrlf&"<td align='right'>"&funpage&"&nbsp;</td>"&_
				 vbcrlf&"</tr></table></td></tr>"&_
			  vbcrlf&"</table>"
	 if err.number<>0 then
	 err.clear	
	response.redirect(""&cityurl&"/include/error.asp?err=分页函数出错，请与管理员联系！|")
	 end if
end function


'*************************
'功能：分页
'修正了在搜索中不能正确分页的BUG...
'*************************
function funpage_search(Intpagecount,Intmypage,Intrecordcount,Intpagesize)
	 on error resume next
	 dim Intfor,Intlist,intlist_b
	 Dim query, a, x, temp
    action = "http://" & Request.ServerVariables("HTTP_HOST") & replace(Request.ServerVariables("SCRIPT_NAME"),".asp",".html")
    query = Split(Request.ServerVariables("QUERY_STRING"), "&")
    For Each x In query
     a = Split(x, "=")
     If StrComp(a(0), "page", vbTextCompare) <> 0 Then
     temp = temp & a(0) & "=" & a(1) & "&"
     End If
    Next  
	 if intmypage>1 then
		 funpage_search=funpage_search & "<a href='"&action&"?"&temp&"page=1' title='最前页' class='no'><font face='Webdings'>9</font></a>"
		 funpage_search=funpage_search&"<a href='"&action&"?"&temp&"page="&Intmypage-1 & "' title='上一页' class='no'><font face='Webdings'>7</font></a>"
	 else
		 funpage_search=funpage_search &"<font face='Webdings'>9</font>"
	 	 funpage_search=funpage_search&"<font face='Webdings'>7</font>"
	 end if
	 if Intlist<>0 then
		 if cintmypage= Intlist then
			Intlist=Intlist+5		
		 end if
	  else
	  	Intlist=Intmypage+5
	  end if
	  if intlist-9<1 then
	     intlist_b=1
	  else
	  	 intlist_b=intlist-9
	  end if		
	  for Intfor=intlist_b to Intlist          
	 	 if intfor<=Intpagecount then              
		 	 if intfor=Intmypage then       '-------使当前页文字为红色，并不可点击
				 funpage_search =funpage_search & strMode&" <font color='#FF0000'><b>"& Intfor & "</b></font>"
			 else
				 funpage_search=funpage_search & strMode &" <a href='"&action&"?"&temp&"page=" & Intfor &"' class='no'>" & Intfor & "</a>"
			 end if
		 end if
		 strMode=" <font color='#BBBBBB'>|</font> "
	  next
	  if intmypage<intpagecount then
	  	funpage_search=funpage_search&" <a href='"&action&"?"&temp&"page="& Intmypage+1 &"' title='后一页' class='no'><font face='Webdings'>8</font></a>"
	    funpage_search=funpage_search &"<a href='"&action&"?"&temp&"page="& Intpagecount & "' title='最后页' class='no'><font face='Webdings'>:</font></a>"
	  else
	  	funpage_search=funpage_search&" <font face='Webdings'>8</font>"	
	    funpage_search=funpage_search &"<font face='Webdings'>:</font></a>"
	  end if
	  funpage_search="<table width='100%' border='0' cellspacing='0' cellpadding='0'><tr>"&_ 
				vbcrlf&"<td width='40%'>&nbsp;当前第"&Intmypage&"页 　"&Intpagesize&"条/页 　共"&Intpagecount&"页/"&Intrecordcount&"条</td>"&_
				vbcrlf&"<td width='60%' align='right'>"&_
				vbcrlf&"<table width='360' border='0' cellspacing='0' cellpadding='0'><tr>"&_
				vbcrlf&"<td align='right'>"&funpage_search&"&nbsp;</td>"&_
				 vbcrlf&"</tr></table></td></tr>"&_
			  vbcrlf&"</table>"
	 if err.number<>0 then
	 err.clear	
	response.redirect(""&cityurl&"/include/error.asp?err=分页函数出错，请与管理员联系！|")
	 end if
end function
'----------------------------------------------------------------------
'	函数功能：　屏蔽ＨＴＭＬ代码 
'	参　　数：　StrInput 用户输入信息
'----------------------------------------------------------------------
Function FunHtml(strHtml)
        Dim strPatrn
            strPatrn="<.*?>"
        Dim regEx
        Set regEx = New RegExp
        regEx.Pattern = strPatrn
        regEx.IgnoreCase = True
        regEx.Global = True
        FunHtml = regEx.Replace(strHtml,"")
   End Function
   
'//热门搜索关键词
Function Hotkeyword()
	Dim StrSql,Rs,ArrayKeyword,Inti,LngCharLen
	Hotkeyword=""
	LngCharLen=0
	StrSql="select C_Keyword from Asean_config"
	Set Rs=Server.CreateObject("Adodb.RecordSet")
	Rs.Open StrSql,Conn,1,1
	If Not Rs.Eof Then
		ArrayKeyword=Split(Rs("C_Keyword"),",")
		For Inti=0 To Ubound(ArrayKeyword)
			If LngCharLen>44 Then
				Exit For
			End If
			LngCharLen=LngCharLen+Len(ArrayKeyword(Inti))+1
			Hotkeyword=Hotkeyword&"<a href=""../info/search.asp?Keyword="&ArrayKeyword(Inti)&""" target=""_blank"">"&ArrayKeyword(IntI)&"</a>"&"&nbsp;"
		Next
	End If
	Rs.CLose:Set Rs=Nothing
End Function
'///热门资讯排行---搜索
function HotArticle()
dim rshot
	HotArticle=""
	StrSql="select top 10 Title,N_url,inputtime from Siruo_Article where N_CreateFile=1 and N_channelid="&ChannelID&" order by hits desc"
	Set rshot=Server.CreateObject("Adodb.RecordSet")
	rshot.Open StrSql,Conn,1,1
	Do While Not rshot.Eof
		HotArticle=HotArticle&"·<a href="""&NewsPath&"/"&rshot("N_url")&""" target=""_Blank"" title="&Rs("Title")&">"&Left(rshot("Title"),12)&"</a><br> "
		rshot.MoveNext
	Loop
	rshot.Close:Set rshot=Nothing
	end function
%>
<%
'///资讯分类
function navigation()
dim rsnav
navigation=navigation&"| <a href=""index.asp"">"&C_name&"</a> | "
Set rsnav=server.createobject("adodb.recordset")
sql="SELECT TOP 10 ID,ClassName,Nav,ordernum FROM Siruo_Articlebigclass WHERE Nav=1 and channelid="&channelid&" ORDER BY ordernum,id desc"
rsnav.open sql,conn,1,1
Do while not rsnav.eof
if jthtml=1 then
	bigclassurl="list_"&rsnav("id")&".html"
	else
	bigclassurl="list.asp?bigclassid="&rsnav("id")&""
	end if
navigation=navigation&"<a href="""&bigclassurl&""">"&rsnav("ClassName")&"</a> | "
rsnav.movenext
loop
rsnav.close:set rsnav=Nothing
end function
end if
%>