去除文本中html标签的小偷函数

最新推荐文章于 2024-10-09 11:23:49 发布

loyos

最新推荐文章于 2024-10-09 11:23:49 发布

阅读量1.8k

点赞数

分类专栏：小偷采集文章标签： html function blog layer

小偷采集专栏收录该内容

10 篇文章 0 订阅

订阅专栏

想想自己BLOG 还是空的就加点内容
顺便问下怎么加别人的文章到自己的BLOG

函数用于去除文本中的html标签,可以控制删除哪些标签.
要控制被删除的标签列表,可以通过向TAGLIST常数中添加/删除标记来实现. 例如,要保留所有的<B>标签,则从TAGLIST中删除B. 当前的列表包含了MSDN中的所有html标签以及 LAYER 标签. 每个标签要用";"括起来.
开始标签和结束标签都会被删除,例如"<A...>"和</A...>
若标签同时在 TAGLIST 和 BLOCKTAGLIST 常数中,则起始标签和结束标签之间的所有内容都会被删除
没有结束标记的标签不被视为html标签,其内容不会被删除
块标签若没有结尾标记,从此标签开始到文本结束的所有内容会被删除
若"<!--"后跟的字符不是空格,注释标签不会被删除
使用这个函数很简单:
strPlainText = RemoveHTML(strTextWithHTML)
函数内容如下:

Function RemoveHTML( strText )
Dim TAGLIST
TAGLIST = ";!--;!DOCTYPE;A;ACRONYM;ADDRESS;APPLET;AREA;B;BASE;BASEFONT;" &_
            "BGSOUND;BIG;BLOCKQUOTE;BODY;BR;BUTTON;CAPTION;CENTER;CITE;CODE;" &_
            "COL;COLGROUP;COMMENT;DD;DEL;DFN;DIR;DIV;DL;DT;EM;EMBED;FIELDSET;" &_
            "FONT;FORM;FRAME;FRAMESET;HEAD;H1;H2;H3;H4;H5;H6;HR;HTML;I;IFRAME;IMG;" &_
            "INPUT;INS;ISINDEX;KBD;LABEL;LAYER;LAGEND;LI;LINK;LISTING;MAP;MARQUEE;" &_
            "MENU;META;NOBR;NOFRAMES;NOSCRIPT;OBJECT;OL;OPTION;P;PARAM;PLAINTEXT;" &_
            "PRE;Q;S;SAMP;SCRIPT;SELECT;SMALL;SPAN;STRIKE;STRONG;STYLE;SUB;SUP;" &_
            "TABLE;TBODY;TD;TEXTAREA;TFOOT;TH;THEAD;TITLE;TR;TT;U;UL;VAR;WBR;XMP;"

Const BLOCKTAGLIST = ";APPLET;EMBED;FRAMESET;HEAD;NOFRAMES;NOSCRIPT;OBJECT;SCRIPT;STYLE;"

Dim nPos1
Dim nPos2
Dim nPos3
Dim strResult
Dim strTagName
Dim bRemove
Dim bSearchForBlock

nPos1 = InStr(strText, "<")
Do While nPos1 > 0
      nPos2 = InStr(nPos1 + 1, strText, ">")
      If nPos2 > 0 Then
         strTagName = Mid(strText, nPos1 + 1, nPos2 - nPos1 - 1)
      strTagName = Replace(Replace(strTagName, vbCr, " "), vbLf, " ")

         nPos3 = InStr(strTagName, " ")
         If nPos3 > 0 Then
            strTagName = Left(strTagName, nPos3 - 1)
         End If

         If Left(strTagName, 1) = "/" Then
            strTagName = Mid(strTagName, 2)
            bSearchForBlock = False
         Else
            bSearchForBlock = True
         End If

         If InStr(1, TAGLIST, ";" & strTagName & ";", vbTextCompare) > 0 Then
            bRemove = True
            If bSearchForBlock Then
                  If InStr(1, BLOCKTAGLIST, ";" & strTagName & ";", vbTextCompare) > 0 Then
                     nPos2 = Len(strText)
                     nPos3 = InStr(nPos1 + 1, strText, "</" & strTagName, vbTextCompare)
                     If nPos3 > 0 Then
                        nPos3 = InStr(nPos3 + 1, strText, ">")
                     End If

                     If nPos3 > 0 Then
                        nPos2 = nPos3
                     End If
                  End If
            End If
         Else
            bRemove = False
         End If

         If bRemove Then
            strResult = strResult & Left(strText, nPos1 - 1)
            strText = Mid(strText, nPos2 + 1)
         Else
            strResult = strResult & Left(strText, nPos1)
            strText = Mid(strText, nPos1 + 1)
         End If
      Else
         strResult = strResult & strText
         strText = ""
      End If

      nPos1 = InStr(strText, "<")
Loop
strResult = strResult & strText

RemoveHTML = strResult
End Function