函数功能：　通用分页

'--------------------------------------------------------------------------
' 函数功能：　通用分页
' 参    数:   Intpagecount　总页数
'    Intmypage 当前页数
'    Intrecordcount 记录总数
'    Intpagesize 每页显示的记录数
'--------------------------------------------------------------------------
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%' style=font:14px> 当前第"&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' style=font:14px>"&funpage&" </td>"&_
     vbcrlf&"</tr></table></td></tr>"&_
     vbcrlf&"</table>"
if err.number<>0 then
err.clear
response.redirect("error.asp?err=分页函数出错，请与管理员联系！|")
end if
end function
'***************************************************
'函数名：Highlight
'功能:搜索的关键词以高亮的颜色显示
'参数strText是要被高亮显示的字符串或变量所在的字串或变量
'strFind是要被高亮显示的字符串或变量,
'strBefore被高亮显示的HTML代码前缀如：<font color=red>
'strAfter被高亮显示的HTML代码的后缀:</font>
'*****************************************************
Function Highlight(strText, strFind, strBefore, strAfter)
Dim nPos
Dim nLen
Dim nLenAll

nLen = Len(strFind)
nLenAll = nLen + Len(strBefore) + Len(strAfter) + 1
Highlight = strText
If nLen > 0 And Len(Highlight) > 0 Then
nPos = InStr(1, Highlight, strFind, 1)
Do While nPos > 0
Highlight = Left(Highlight, nPos - 1) & _
strBefore & Mid(Highlight, nPos, nLen) & strAfter & _
Mid(Highlight, nPos + nLen)
nPos = InStr(nPos + nLenAll, Highlight, strFind, 1)
Loop
End If
End Function