单篇文章自动分页函数

<%
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
%>

posted on 2009-08-18 18:39  xieguang133  阅读(125)  评论(0)    收藏  举报

导航