www.gusucode.com > cso中国seo优化html整站源码程序 > include/fun.asp

    <%
'判断字符
Public Function xlen(strText)
Dim k,i,c
Dim ForTotal

k=0 
ForTotal = Len(strText)
For i = 1 To ForTotal
	c = Abs(AscW(Mid(strText,i,1)))
	If c > 255 Then
		k = k + 2
	Else
		k = k + 1
	End If
Next
xlen = k
End Function

'截取字符
Public Function xleft(Title,TLen)
Dim k,i,d,c
Dim iStr
Dim ForTotal

If CDbl(TLen) > 0 Then
	k = 0 
	d = xLen(Title)
	iStr = ""
	ForTotal = Len(Title)
	
	For i = 1 To ForTotal
		c = Abs(AscW(Mid(Title,i,1)))
		If c > 255 Then
			k = k + 2
		Else
			k = k + 1
		End If
		
		iStr = iStr&Mid(Title,i,1)
		
		If CLng(k) > CLng(TLen) Then 
			iStr = iStr&".."
			Exit For
		End If
	Next
	
	xleft = iStr
Else
	xleft = ""
End If
End Function


function id2formstr(id,table,formstr)
dim rs,sql
set rs = server.createobject("adodb.recordset")
sql = "select * from "&table&" where id = "&id
rs.open sql,conn,1,1
if rs.eof then
	id2formstr = "<strong class=""markfont"">[未知]</storng>"
else
	id2formstr = rs(formstr)
end if
rs.close
set rs = nothing
end function

Function db_count(sql)
dim rs
set rs = server.createobject("adodb.recordset")
rs.open sql,conn,1,1
db_count = rs.recordcount
rs.close
set rs = nothing
End Function

Function redir(pathstr)
response.write "<script type=""text/javascript"">"
response.write "location.href="""&pathstr&""";</script>"
End Function

Function alert(str,pathstr)
response.write "<script type=""text/javascript"">"
response.write "alert("""&str&""");"
response.write "location.href="""&pathstr&""";</script>"
End Function


'分页函数
'===========rs.pagesize = 20
'===========page = int(request.querystring("page"))
'===========if page = 0 then page = 1
'===========if page = "" then page = 1
'===========rs.AbsolutePage = page
'===========pagec = rs.pagecount
'===========if page > pagec then page = pagec
function dispartpage(page,pagec,pathstr)		'pathstr是路径，后边加&
Dim ps,ps_2
ps = ""
ps_2 = ""
for i = 1 to pagec
if page = i then
	ps_2 = ps_2 & "<a href='?"&pathstr&"page="&i&"' class='curpage'>"&i&"</a>"
else
	ps_2 = ps_2 & "<a href='?"&pathstr&"page="&i&"'>"&i&"</a>"
end if
next
if page = 1 and pagec = 1 then 
	ps = ""
	ps = ps & ps_2
elseif page > pagec then
	ps = "<a href='?"&pathstr&"page=1'><< 首页</a>"
	ps = ps & ps_2
elseif page = 1 and page < pagec then
	ps = ps_2
	ps = ps & "<a href='?"&pathstr&"page="&page+1&"'>下一页 ></a>"
	ps = ps & "<a href='?"&pathstr&"page="&pagec&"'>尾页 >></a>"
elseif page > 1 and page = pagec then
	ps = "<a href='?"&pathstr&"page=1'><< 首页</a>"
	ps = ps & "<a href='?"&pathstr&"page="&page-1&"'>< 上一页</a>"
	ps = ps & ps_2
else
	ps = "<a href='?"&pathstr&"page=1'><< 首页</a>"
	ps = ps & "<a href='?"&pathstr&"page="&page-1&"'>< 上一页</a>"
	ps = ps & ps_2
	ps = ps & "<a href='?"&pathstr&"page="&page+1&"'>下一页 ></a>"
	ps = ps & "<a href='?"&pathstr&"page="&pagec&"'>尾页 >></a>"
End if
dispartpage = ps
end function

'过滤HTML
Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp 
objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
Set Matches = objRegExp.Execute(strHTML) 
' 遍历匹配集合，并替换掉匹配的项目 
For Each Match in Matches 
strHtml=Replace(strHTML,Match.Value,"") 
Next 
RemoveHTML=strHTML 
Set objRegExp = Nothing 
End Function 
%>