Asp ile başlıklardan html kodu temizleme (Yardım) - Sayfa 2

09-05-2017, 00:44:31

#10

Evet çok değişkenlik bir durum varsa replace ile bayağı sıkıntılı. Hepsini teker teker fonksiyonun içine koymanız gerekir.

Regex kullanımının başka bir örneğini koyuyorum.

function BaslikTemizle(baslik)
Set regexobj = New RegExp
With regexobj 
.IgnoreCase = True
.MultiLine = False
.Global = True
.Pattern = "<[^>]*>" : baslik = .Replace(baslik, " ") 'HTML Tag
.Pattern = "\n" : baslik = .Replace(baslik, " ") 'Enter
.Pattern = "(\t)+" : baslik = .Replace(baslik, " ") 'Tablar
.Pattern = "  +" : baslik = .Replace(baslik, " ") 'Birden fazla boşluk
End With
set regexobj = nothing	
BaslikTemizle = baslik		
end function

13-05-2017, 21:42:15

#11

ustunweb

WebnetMasteR adlı üyeden alıntı: mesajı görüntüle

S.a cümleten arkadaşlar

Haberlerin başlıklarını listelerken başlıktaki

</p>
</strong>

font size color gibi vb birçok html kodlarını temizlemem gerekiyor...

<%=rshaber("baslik")%> koduyla başlıkları listeletiyorum.

Alt seviyed bilgim var, bu htmleri temizleme konusunda kodsal yardımcı olursanız çok makbüle geçecek arkadaşlar.

Şimdiden tşkler.

Diğer arkadaşların verdikleri senin işini çok fazla görmez buyur benim kodumu kullan;

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