<%
' 使用实例:
' Dim strCnt
' strCnt = "<P>0<FONT face=Verdana>1<BR>2<BR>3<BR>4</FONT><table><tr><td></td></tr></table>5</P>6"
'
' Dim clsDoc,content,setpage
'
' Set clsDoc = new splitDoc
' clsDoc.sStr = str(0)     字符串
' clsDoc.pageSize = 1      第页显示的字符数(可选,默认为1000个字符)
' clsDoc.curPage = Request("docpage")  要显示的页码
' content = clsDoc.getStr()    截取后的内容
' setpage = clsDoc.showPage(para)   翻页
' Set clsDoc = Nothing
Class splitDoc
    Private sRegExp         '正则对象
    Private arrLable        '存放标签的数组
    Private arrTotal        '存放数据和空标签的数组
    Private isInFst         '标签是否在字符串的开始
    Private isNeedSplit     '是否需要分隔
    Private isIncLabel      '字符串是否含有标签
    Private delimiter       '分隔符
    Public sStr             '字符串
    Public pageSize         '每页显示的字数---默认为1000字
    Public curPage          '现在要显示的页码---默认为第一页
    Private totalPage        '共有几页
    Public Function getStr()
        Call chkNeedR
        If isNeedSplit Then
            Dim iLable, iTotal, tmpNum, curNum, startNum, endNum, startPos, lenTmp, strTmp
   Call chkCurPage()
            If Not isIncLabel Then '不含有标签,直接截取
                startPos = pageSize * (curPage - 1) + 1
                getStr = Mid(sStr, startPos, pageSize)
            Else
                curNum = 0
                startNum = pageSize * (curPage - 1) + 1
                endNum = pageSize * curPage
                iLable = 0
                Call getArrLable
                Call getArrTotal
                For iTotal = 0 To UBound(arrTotal)
                    lenTmp = Len(arrTotal(iTotal))
                    If lenTmp > 0 Then
                        If curNum < startNum Then
                            If curNum + lenTmp >= startNum Then
                                If curNum + lenTmp >= endNum Then
         strTmp = strTmp & Mid(arrTotal(iTotal), startNum - curNum, endNum - startNum + 1)
                                    strTmp = strTmp & joinArrLable(iLable)
                                    Exit For
                                Else
                                    strTmp = strTmp & Mid(arrTotal(iTotal), startNum - curNum)
                                    curNum = curNum + lenTmp
                                End If
                            Else
                                curNum = curNum + lenTmp
                            End If
                        ElseIf curNum < endNum Then
                            If curNum + lenTmp <= endNum Then
                                strTmp = strTmp & arrTotal(iTotal)
                                curNum = curNum + lenTmp
                            Else
                                strTmp = strTmp & Mid(arrTotal(iTotal), 1, endNum - curNum)
                                strTmp = strTmp & joinArrLable(iLable)
                                Exit For
                            End If
                        Else
                            strTmp = strTmp & joinArrLable(iLable)
                            Exit For
                        End If
                        strTmp = strTmp & addALable(iLable)
                    Else
                        strTmp = strTmp & addALable(iLable)
                    End If
                Next
                getStr = TrimBlank(strTmp)
            End If
        Else
            getStr = sStr
        End If
    End Function
    Private Function joinArrLable(strtIndex)
        Dim i
        For i = strtIndex To UBound(arrLable)
            joinArrLable = joinArrLable & arrLable(i)
        Next
    End Function
 Private Sub chkCurPage()
  If Not IsNumeric(curPage) Then
   curPage=1
  ElseIf CDbl(curPage)<1 Then
   curPage = 1
  ElseIf CDbl(curPage)>totalPage Then 
   curPage=totalPage
  End If
 End Sub
    Private Function addALable(index)
        If index <= UBound(arrLable) Then
            addALable = arrLable(index)
            index = index + 1
        End If
    End Function
    Private Sub Class_Initialize()
        Set sRegExp = New RegExp
        sRegExp.Pattern = "<[^>]*>"
        sRegExp.IgnoreCase = True
        sRegExp.Global = True
        pageSize = 1000
        curPage = 1
        delimiter = "$split"
    End Sub
    
    Private Function TrimBlank(ByVal str)
  Dim arrPattern(2),i
  arrPattern(0) = "<tr[^>]*>(<td[^>]*>\s*<\/td>)*<\/tr>"
  arrPattern(1) = "<table[^>]*><\/table>"
  arrPattern(2) = "<p[^>]*>(<\/?[^>]*>)*</p>"
  For i=0 To UBound(arrPattern)
   sRegExp.Pattern = arrPattern(i)
   str = sRegExp.Replace(str, "")   
  Next
  TrimBlank = str
    End Function
    
    Private Sub Class_Terminate()
        Set sRegExp = Nothing
    End Sub
    Private Sub getArrLable()
        Dim Match, Matches, RetStr, strTmp
        strTmp = sStr
        Set Matches = sRegExp.Execute(strTmp)
        For Each Match In Matches
            RetStr = RetStr & delimiter & Match.Value
        Next
        arrLable = Split(Mid(RetStr, Len(delimiter) + 1), delimiter)
    End Sub
    Private Sub getArrTotal()
        Dim strTmp
        strTmp = sStr
        arrTotal = Split(sRegExp.Replace(strTmp, delimiter), delimiter)
    End Sub
    Private Sub chkNeedR()
  On Error Resume Next
        Dim strTmp, totalChr
        strTmp = sStr
        totalChr = Len(sRegExp.Replace(strTmp, ""))
        If Len(strTmp) <= pageSize Or totalChr <= pageSize Then
            totalPage = 1
            isNeedSplit = False
        Else
            totalPage = Fix(totalChr / pageSize)
            If (totalChr Mod pageSize) <> 0 Then totalPage = totalPage + 1
            isNeedSplit = True
        End If
        isIncLabel = sRegExp.test(strTmp)
    End Sub
    
    Public Function showPage(para)
        Dim arr,i,n
  ReDim arr(totalPage)
        For i = 1 To totalPage
            If CStr(i) = CStr(curPage) Then
                arr(n) = "<span style=""color:red;"">[" & i & "]</span> "
            Else
                arr(n) = "<a href='?Aid="&Aid&"&docpage=" & i & para & "'>[" & i & "]</a> "
            End If
            n = n + 1
        Next
        If totalPage > 1 Then showPage = "<div class=""docpage"" style=""text-align:center;"">" & Join(arr, "") & "</div>"
    End Function
End Class
%>
调用方法
'调用
Set clsDoc = new splitDoc
clsDoc.sStr = Mycontent
'clsDoc.pageSize =400 '按字数分页
isNeedSplit=True
delimiter="[NextPage]"
clsDoc.curPage = Request("docpage")
content = clsDoc.getStr()
setpage = clsDoc.showPage(para)
Set clsDoc = Nothing
%>
<div class="content"><%=Replace(content,"<br><br>","",1,-1,1)%></div>
<div class="setpage"><%=setpage%></div>