Three functions for removing HTML tags from asp

Source: Internet
Author: User

Copy codeThe Code is as follows: '====================================
'Function Description: Remove HTML tags with regular expressions
'You cannot retain <B> <strong> and other custom <and>
'====================================

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

'====================================
'Function Description: Remove HTML tags
'You cannot retain <B> <strong> and other custom <and>
'====================================

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

'====================================
'Function Description: Remove HTML tags
'Removing custom tags may be slow.
'====================================

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

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.