源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
楼主: ttx9n

[ASP编程] asp中去除内容HTML标签的三个function函数

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2007-3-20 00:00:00 | 显示全部楼层 |阅读模式
复制代码 代码如下:
'==============================
'功能描述: 用正则除去HTML标记
'不能保留<b><strong>等以及用户自定义的<和>
'==============================

Function RemoveHTMLTag(fString)
        Dim re
        Set re = New RegExp
        re.IgnoreCase = True
        re.Pattern = "<(.[^>]*)>"
        fString = re.Replace(fString, "")
        Set re = Nothing
        RemoveHTMLTag = fString
End Function

'==============================
'功能描述: 除去HTML标记
'不能保留<b><strong>等以及用户自定义的<和>
'==============================

Function Remove_HTML(Str)
        Dim ilen1, ilen2
        Do While InStr(1, Str, "<", 1) >0
                ilen1 = InStr(1, Str, "<", 1)
                ilen2 = InStr(1, Str, ">", 1)
                Str = Left(Str, ilen1 -1) & Mid(Str, ilen2 + 1)
        Loop
        Remove_HTML = Str
End Function

'==============================
'功能描述: 除去HTML标记
'去除自定义的标记,速度可能有点慢
'==============================

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
        strResult = Replace(strResult, Chr(9), "")
        strResult = Replace(strResult, Chr(32), "")
        strResult = Replace(strResult, Chr(13), "")
        strResult = Replace(strResult, Chr(10), "")
        strResult = Replace(strResult, vbCrLf, "")
        RemoveHTML = strResult
End Function
回复

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2022-8-20 01:35:13 | 显示全部楼层
源码源码源码源码源码源码源码源码源码源码源码源码源码
回复 支持 反对

使用道具 举报

13

主题

2万

回帖

85

积分

注册会员

Rank: 2

积分
85
发表于 2022-9-3 16:49:32 | 显示全部楼层
我找了挺久终于找到了
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

186

积分

注册会员

Rank: 2

积分
186
发表于 2023-1-3 08:41:59 | 显示全部楼层
还可以不错
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-2-2 21:46:08 | 显示全部楼层
先把创新班才能下班才能下班
回复 支持 反对

使用道具 举报

3

主题

2万

回帖

50

积分

注册会员

Rank: 2

积分
50
发表于 2023-9-1 23:47:18 | 显示全部楼层
还可以不错
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-11-23 13:16:01 | 显示全部楼层
借款金额看了就立刻
回复 支持 反对

使用道具 举报

27

主题

2万

回帖

331

积分

中级会员

Rank: 3Rank: 3

积分
331
发表于 2024-6-7 19:53:24 | 显示全部楼层
看看看看看看看看看看看看看看看看看看看看看看看看看看看
回复 支持 反对

使用道具 举报

1

主题

2万

回帖

55

积分

注册会员

Rank: 2

积分
55
发表于 2024-6-19 21:01:45 | 显示全部楼层
管灌灌灌灌灌灌灌灌灌灌
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

473

积分

中级会员

Rank: 3Rank: 3

积分
473
发表于 2024-7-27 10:45:19 | 显示全部楼层
非常vbcbvcvbvcb
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-12-3 05:41 , Processed in 0.079499 second(s), 22 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表