ASP:截取文章摘要（无损HTML）保留html标签，有待高手完善

网上我看一下截取文章保留html标签的，就下面这个还靠谱，不过这个还是不正确

自动补全HTML元素：嗯，这个思路不错
         引：其实想法很早就有了，尤其是今年年初受到HTML特性的启发，但是当时的算法太繁琐，而且效率低，自己也没心思去弄。于是就搁置在那里。今天凌晨睡不 着，想到后重新构建了算法，并且在脑子里“试运行”了几遍，优化了一下后就把程序敲出来了。觉得也没有想象中的那么难，轻轻松松就解决了。所以，程序员一 定不能懒。
        在这个算法里，运用了栈，因为HTML元素有始必有终嘛。看看代码就晓得咯。

str=HTMLCutter(str,500)
'无损截取HTML
Function HTMLCutter(str, l)
    '声明一个栈，100层够大吧
    Dim sFIFO(100)
    '一些参数
    p = 1
    str = Trim(str)
    maxlong = Len(str)
    '参数
    FlagHTML = False
    longStr = 0
    '开始扫描文章
    For i = 1 To maxlong
        '提取第i位的字符
        c = Mid(str, i, 1)
        '判断HTML元素开始
        If c = "<" Then
            If FlagHTML Then longStr = longStr + i - istart
            FlagHTML = True
            istart = i
        Else
            If FlagHTML Then
                If c = ">" Then
                    iend = i
                    tmpStr = Mid(str, istart + 1, iend - istart - 1)
                   
                    '检查元素为开始还是结束
                    '判断是否是的标签
                    If Right(tmpStr, 1) <> "/" Then
                        If Left(tmpStr, 1) = "/" Then
                            '结束标签
                            If sFIFO(p) = Right(tmpStr, Len(tmpStr) - 1) Then p = p - 1
                           
                            FlagHTML = False
                        Else
                            '开始标签
                            p = p + 1
                           
                            t = InStr(1, tmpStr, " ")
                            If t <> 0 Then tmpStr = Left(tmpStr, t - 1)
                           
                            sFIFO(p) = tmpStr
                        End If
                    End If
                End If
            Else
                longStr = longStr + 1
                If longStr >= l Then Exit For
            End If
        End If
    Next
   
    fStr = Left(str, i)
     '把没有闭合的HTML元素补上
    For j = p To 1 Step -1
        If sFIFO(j) <> "" Then endStr = endStr & "     Next
   
    HTMLCutter = fStr & endStr
End Function

'=================上面是我从网上摘下的，试过后，都没能达到效果，与是我改进了一下，代码如下=============

'------这种方法还不完善(无法检查方括号里的不标签的文字)，哪位能完善或改进的话，请给我发一份(QQ:562536585)------

Function HTMLCutter(str, l)
'声明一个栈，100层够大吧
Dim sFIFO(100)
'一些参数
p = 1
str = Trim(str)
maxlong = Len(str)
'Response.Write "<script language='javascript'>alert('"&maxlong&"')/script>"
'参数
FlagHTML = False
longStr = 0
'开始扫描文章

For i = 1 To maxlong
   '提取第i位的字符
   c = Mid(str, i, 1)
   '判断HTML元素开始
   If c = "<" Then
    'If FlagHTML Then longStr = longStr + i - istart
    FlagHTML = True
    istart = i
   Else
    If FlagHTML Then
     If c = ">" Then
      iend = i
      tmpStr = Mid(str, istart + 1, iend - istart - 1)     
      '检查元素为开始还是结束
      '判断是否是的标签
      If Right(tmpStr, 1) <> "/" Then
       If Left(tmpStr, 1) = "/" Then
        '结束标签
        If sFIFO(p) = Right(tmpStr, Len(tmpStr) - 1) Then p = p - 1
        'FlagHTML = False
       Else
        '开始标签
        p = p + 1
        t = InStr(1, tmpStr, " ")
        If t <> 0 Then tmpStr = Left(tmpStr, t - 1)
        sFIFO(p) = tmpStr
       End If
      End If
      FlagHTML = False
     End If
    Else
     longStr = longStr + 1
     If longStr >= l Then Exit For
   End If
End If
Next
fStr = Left(str, i)
If i<maxlong Then fStr=fStr&"……"&"[<a href='article.asp?id=3'>详情</a>]"
'把没有闭合的HTML元素补上
For j = p To 1 Step - 1
   If sFIFO(j) <> "" Then endStr = endStr & "</"& sFIFO(j) &">"
Next
HTMLCutter = fStr & endStr
End Function