单篇文章自动分页函数
<%
Function AutoSplitPages(StrNewsContent)
Dim Inti,StrTrueContent,iPageLen,DLocation,XLocation,FoundStr
If StrNewsContent<>"" and AutoPagesNum<>0 and instr(1,StrNewsContent,"$Page_Split_page$")=0 then
Inti=instr(1,StrNewsContent,"<")
If inti>=1 then '新闻中存在Html标记
StrTrueContent=left(StrNewsContent,Inti-1)
iPageLen=IStrLen(StrTrueContent)
inti=inti+1
Else '新闻中不存在Html标记,对内容直接分页即可
dim i,c,t
do while i< len(StrNewsContent)
i=i+1
c=Abs(Asc(Mid(StrNewsContent,i,1)))
if c>255 then '判断为汉字则为两个字符,英文为一个字符
t=t+2
else
t=t+1
end if
if t>=AutoPagesNum then '如果字数达到了分页的数量则插入分页符号
StrNewsContent=left(StrNewsContent,i)&"$Page_Split_page$"&mid(StrNewsContent,i+1)
i=i+6
t=0
end if
loop
AutoSplitPages=StrNewsContent '返回插入分页符号的内容
Exit Function
End If
iPageLen=0
'新闻中存在Html标记时,则用下面的语句来处理
do while instr(Inti,StrNewsContent,">")<>0
DLocation=instr(Inti,StrNewsContent,">") '只计算Html标记之外的字符数量
XLocation=instr(DLocation,StrNewsContent,"<")
If XLocation>DLocation+1 then
Inti=XLocation
StrTrueContent=mid(StrNewsContent,DLocation+1,XLocation-DLocation-1)
iPageLen=iPageLen+IStrLen(StrTrueContent) '统计Html之外的字符的数量
If iPageLen>AutoPagesNum then '如果达到了分页的数量则插入分页字符
FoundStr=Lcase(left(StrNewsContent,XLocation-1))
If AllowSplitPages(FoundStr,"table|a|b>|i>|strong|div")=true then
StrNewsContent=left(StrNewsContent,XLocation-1)&"$Page_Split_page$"&mid(StrNewsContent,XLocation)
iPageLen=0 '重新统计Html之外的字符
End If
End If
ElseIf XLocation=0 then '在后面再也找不到<,即后面没有Html标记了
Exit Do
ElseIf XLocation=DLocation+1 then '找到的Html标记之间的内容为空,则继续向后找
Inti=XLocation
End If
loop
End If
AutoSplitPages=StrNewsContent
End Function
%>
东莞龙光网络
提供各种平台的解决方案
网站建设与网站改版
百度SEO(自然排名优化,年付)
中国商机发布引擎(软件)
SEO顾问咨询(门户站)
网络推广外包(月付
http://www.xieguang133.com/
posted on 2009-08-18 18:39 xieguang133 阅读(128) 评论(0) 收藏 举报
浙公网安备 33010602011771号