2011-05-24 26 views
8

Estoy tratando de convertir códigos HTML como el & #XXXX; (donde XXXX es un número) al texto plano usando ASP clásico (VBScript).ASP clásico (VBScript) convertir códigos HTML a texto sin formato

Estoy agregando el texto a un correo electrónico que está en formato de texto plano y si los agrego como códigos HTML, simplemente muestra el código y no los convierte.

Una solución sería cambiar el correo electrónico para que sea HTML, lo que soluciona ese problema, pero luego causa otros problemas para mi correo electrónico que no voy a entrar.

¿Existe una función incorporada o una función personalizada que pueda usar para convertir estos códigos HTML a texto sin formato?

Respuesta

17

Lo que necesita es decodificación de HTML, aunque desafortunadamente ASP no incluye uno.

Esta función, que se encuentra en ASP Nut, y la modifiqué en gran medida, debería hacer lo que necesita. Lo probé como vbscript en mi computadora local y parecía funcionar bien, incluso con símbolos Unicode en el rango 1000+.

Function HTMLDecode(sText) 
    Dim regEx 
    Dim matches 
    Dim match 
    sText = Replace(sText, """, Chr(34)) 
    sText = Replace(sText, "<" , Chr(60)) 
    sText = Replace(sText, ">" , Chr(62)) 
    sText = Replace(sText, "&" , Chr(38)) 
    sText = Replace(sText, " ", Chr(32)) 


    Set regEx= New RegExp 

    With regEx 
    .Pattern = "&#(\d+);" 'Match html unicode escapes 
    .Global = True 
    End With 

    Set matches = regEx.Execute(sText) 

    'Iterate over matches 
    For Each match in matches 
     'For each unicode match, replace the whole match, with the ChrW of the digits. 

     sText = Replace(sText, match.Value, ChrW(match.SubMatches(0))) 
    Next 

    HTMLDecode = sText 
End Function 

Nota: Usted necesitará la versión 5.0 de la escritura instalado en su servidor para utilizar el objeto RegExp.

+0

bastante bueno en que uno, los códigos HTML que estoy usando son de letras árabes por lo que los códigos son algo así como lo que obviamente ـ ISN' t cubierto por el para 1 a 255. –

+0

@Scrooby y 'Chr' no admite cosas en ese rango ... un poco de búsqueda indica que la función' ChrW' hace lo que usted quiere con unicode. –

+0

Gracias por la función, aunque estoy teniendo algunos problemas. Cuando intento decodificar una de las letras árabes, por ejemplo ا, solo devuelve un signo de interrogación. Supongo que tiene algo que ver con el conjunto de caracteres de mi página, aunque mi página está configurada en ISO-8859-6, así como el formulario en el que trato de usar el valor. –

-1

Hice esto en base a la respuesta de C.Ross anterior y algún código de una fb_app.inc que alguien más hizo. Debería hacer el truco.

<% 
    Option Explicit 

    Dim objHelper 
    Set objHelper = New HtmlEntityToUnicode 

    Response.Write(objHelper.HtmlDecode("<br/><br/>hi &#128154; green heart! purple heart &#128156; ! ")) 

    Set objHelper = Nothing 

    Class HtmlEntityToUnicode 
    dim BITS_TO_A_BYTE 
    dim BYTES_TO_A_WORD 
    dim BITS_TO_A_WORD 
    Dim m_lOnBits(30) 
    Dim m_l2Power(30) 

    Sub Class_Initialize() 


     BITS_TO_A_BYTE = 8 
     BYTES_TO_A_WORD = 4 
     BITS_TO_A_WORD = 32 

     m_lOnBits(0) = CLng(1) 
     m_lOnBits(1) = CLng(3) 
     m_lOnBits(2) = CLng(7) 
     m_lOnBits(3) = CLng(15) 
     m_lOnBits(4) = CLng(31) 
     m_lOnBits(5) = CLng(63) 
     m_lOnBits(6) = CLng(127) 
     m_lOnBits(7) = CLng(255) 
     m_lOnBits(8) = CLng(511) 
     m_lOnBits(9) = CLng(1023) 
     m_lOnBits(10) = CLng(2047) 
     m_lOnBits(11) = CLng(4095) 
     m_lOnBits(12) = CLng(8191) 
     m_lOnBits(13) = CLng(16383) 
     m_lOnBits(14) = CLng(32767) 
     m_lOnBits(15) = CLng(65535) 
     m_lOnBits(16) = CLng(131071) 
     m_lOnBits(17) = CLng(262143) 
     m_lOnBits(18) = CLng(524287) 
     m_lOnBits(19) = CLng(1048575) 
     m_lOnBits(20) = CLng(2097151) 
     m_lOnBits(21) = CLng(4194303) 
     m_lOnBits(22) = CLng(8388607) 
     m_lOnBits(23) = CLng(16777215) 
     m_lOnBits(24) = CLng(33554431) 
     m_lOnBits(25) = CLng(67108863) 
     m_lOnBits(26) = CLng(134217727) 
     m_lOnBits(27) = CLng(268435455) 
     m_lOnBits(28) = CLng(536870911) 
     m_lOnBits(29) = CLng(1073741823) 
     m_lOnBits(30) = CLng(2147483647) 

     m_l2Power(0) = CLng(1) 
     m_l2Power(1) = CLng(2) 
     m_l2Power(2) = CLng(4) 
     m_l2Power(3) = CLng(8) 
     m_l2Power(4) = CLng(16) 
     m_l2Power(5) = CLng(32) 
     m_l2Power(6) = CLng(64) 
     m_l2Power(7) = CLng(128) 
     m_l2Power(8) = CLng(256) 
     m_l2Power(9) = CLng(512) 
     m_l2Power(10) = CLng(1024) 
     m_l2Power(11) = CLng(2048) 
     m_l2Power(12) = CLng(4096) 
     m_l2Power(13) = CLng(8192) 
     m_l2Power(14) = CLng(16384) 
     m_l2Power(15) = CLng(32768) 
     m_l2Power(16) = CLng(65536) 
     m_l2Power(17) = CLng(131072) 
     m_l2Power(18) = CLng(262144) 
     m_l2Power(19) = CLng(524288) 
     m_l2Power(20) = CLng(1048576) 
     m_l2Power(21) = CLng(2097152) 
     m_l2Power(22) = CLng(4194304) 
     m_l2Power(23) = CLng(8388608) 
     m_l2Power(24) = CLng(16777216) 
     m_l2Power(25) = CLng(33554432) 
     m_l2Power(26) = CLng(67108864) 
     m_l2Power(27) = CLng(134217728) 
     m_l2Power(28) = CLng(268435456) 
     m_l2Power(29) = CLng(536870912) 
     m_l2Power(30) = CLng(1073741824) 

    End Sub 

    Public Function HTMLDecode(sText) 
     Dim regEx 
     Dim matches 
     Dim match 
     sText = Replace(sText, "&quot;", Chr(34)) 
     sText = Replace(sText, "&lt;" , Chr(60)) 
     sText = Replace(sText, "&gt;" , Chr(62)) 
     sText = Replace(sText, "&amp;" , Chr(38)) 
     sText = Replace(sText, "&nbsp;", Chr(32)) 


     Set regEx= New RegExp 

     With regEx 
     .Pattern = "&#(\d+);" 'Match html unicode escapes 
     .Global = True 
     End With 

     Set matches = regEx.Execute(sText) 

     'Iterate over matches 
     For Each match in matches 
     'For each unicode match, replace the whole match, with the ChrW of the digits. 
      sText = Replace(sText, match.Value, "\U"&WordToHex(match.SubMatches(0))) 
     Next 

     HTMLDecode = sText 
    End Function 


    Private Function WordToHex(lValue) 
     Dim lByte 
     Dim lCount 

     For lCount = 0 To 3 
      lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) 
      WordToHex = Right("0" & Hex(lByte), 2) & WordToHex 
     Next 
    End Function 

    Private Function RShift(lValue, iShiftBits) 
     If iShiftBits = 0 Then 
      RShift = lValue 
      Exit Function 
     ElseIf iShiftBits = 31 Then 
      If lValue And &H80000000 Then 
       RShift = 1 
      Else 
       RShift = 0 
      End If 
      Exit Function 
     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
      Err.Raise 6 
     End If 

     RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits) 

     If (lValue And &H80000000) Then 
      RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1))) 
     End If 
    End Function 

    End Class 


    %> 
0

Un decodificador más exausted epanding respuesta C. Ross

Function HTMLDecode(sText) 
    Dim regEx 
    Dim matches 
    Dim match 
    sText = Replace(sText, "&quot;", Chr(34)) 
    sText = Replace(sText, "&lt;" , Chr(60)) 
    sText = Replace(sText, "&gt;" , Chr(62)) 
    sText = Replace(sText, "&amp;" , Chr(38)) 
    sText = Replace(sText, "&nbsp;", Chr(32)) 

    sText = Replace(sText, "&iexcl;", Chr(161)) 
    sText = Replace(sText, "&pound;", Chr(163)) 
    sText = Replace(sText, "&yen;", Chr(165)) 
    sText = Replace(sText, "&copy;", Chr(168)) 
    sText = Replace(sText, "&laquo;", Chr(171)) 
    sText = Replace(sText, "&raquo;", Chr(187)) 
    sText = Replace(sText, "&iquest;", Chr(191)) 
    sText = Replace(sText, "&Agrave;", Chr(192)) 
    sText = Replace(sText, "&Aacute;", Chr(193)) 
    sText = Replace(sText, "&Acirc;", Chr(194)) 
    sText = Replace(sText, "&Atilde;", Chr(195)) 
    sText = Replace(sText, "&Auml;", Chr(196)) 
    sText = Replace(sText, "&Aring;", Chr(197)) 
    sText = Replace(sText, "&AElig;", Chr(198)) 
    sText = Replace(sText, "&Ccedil;", Chr(199)) 
    sText = Replace(sText, "&Egrave;", Chr(200)) 
    sText = Replace(sText, "&Eacute;", Chr(201)) 
    sText = Replace(sText, "&Ecirc;", Chr(202)) 
    sText = Replace(sText, "&Euml;", Chr(203)) 
    sText = Replace(sText, "&Igrave;", Chr(204)) 
    sText = Replace(sText, "&Iacute;", Chr(205)) 
    sText = Replace(sText, "&Icirc;", Chr(206)) 
    sText = Replace(sText, "&Iuml;", Chr(207)) 
    sText = Replace(sText, "&Ntilde;", Chr(209)) 
    sText = Replace(sText, "&Ograve;", Chr(210)) 
    sText = Replace(sText, "&Oacute;", Chr(211)) 
    sText = Replace(sText, "&Ocirc;", Chr(212)) 
    sText = Replace(sText, "&Otilde;", Chr(213)) 
    sText = Replace(sText, "&Ouml;", Chr(214)) 
    sText = Replace(sText, "&times;", Chr(215)) 
    sText = Replace(sText, "&Oslash;", Chr(216)) 
    sText = Replace(sText, "&Ugrave;", Chr(217)) 
    sText = Replace(sText, "&Uacute;", Chr(218)) 
    sText = Replace(sText, "&Ucirc;", Chr(219)) 
    sText = Replace(sText, "&Uuml;", Chr(220)) 
    sText = Replace(sText, "&Yacute;", Chr(221)) 
    sText = Replace(sText, "&THORN;", Chr(222)) 
    sText = Replace(sText, "&szlig;", Chr(223)) 
    sText = Replace(sText, "&agrave;", Chr(224)) 
    sText = Replace(sText, "&aacute;", Chr(225)) 
    sText = Replace(sText, "&acirc;", Chr(226)) 
    sText = Replace(sText, "&atilde;", Chr(227)) 
    sText = Replace(sText, "&auml;", Chr(228)) 
    sText = Replace(sText, "&aring;", Chr(229)) 
    sText = Replace(sText, "&aelig;", Chr(230)) 
    sText = Replace(sText, "&ccedil;", Chr(231)) 
    sText = Replace(sText, "&egrave;", Chr(232)) 
    sText = Replace(sText, "&eacute;", Chr(233)) 
    sText = Replace(sText, "&ecirc;", Chr(234)) 
    sText = Replace(sText, "&euml;", Chr(235)) 
    sText = Replace(sText, "&igrave;", Chr(236)) 
    sText = Replace(sText, "&iacute;", Chr(237)) 
    sText = Replace(sText, "&icirc;", Chr(238)) 
    sText = Replace(sText, "&iuml;", Chr(239)) 
    sText = Replace(sText, "&eth;", Chr(240)) 
    sText = Replace(sText, "&ntilde;", Chr(241)) 
    sText = Replace(sText, "&ograve;", Chr(242)) 
    sText = Replace(sText, "&oacute;", Chr(243)) 
    sText = Replace(sText, "&ocirc;", Chr(244)) 
    sText = Replace(sText, "&otilde;", Chr(245)) 
    sText = Replace(sText, "&ouml;", Chr(246)) 
    sText = Replace(sText, "&divide;", Chr(247)) 
    sText = Replace(sText, "&oslash;", Chr(248)) 
    sText = Replace(sText, "&ugrave;", Chr(249)) 
    sText = Replace(sText, "&uacute;", Chr(250)) 
    sText = Replace(sText, "&ucirc;", Chr(251)) 
    sText = Replace(sText, "&uuml;", Chr(252)) 
    sText = Replace(sText, "&yacute;", Chr(253)) 
    sText = Replace(sText, "&thorn;", Chr(254)) 
    sText = Replace(sText, "&yuml;", Chr(255)) 

    Set regEx= New RegExp 

    With regEx 
    .Pattern = "&#(\d+);" 'Match html unicode escapes 
    .Global = True 
    End With 

    Set matches = regEx.Execute(sText) 

    'Iterate over matches 
    For Each match in matches 
     'For each unicode match, replace the whole match, with the ChrW of the digits. 

     sText = Replace(sText, match.Value, ChrW(match.SubMatches(0))) 
    Next 

    HTMLDecode = sText 
End Function 
Cuestiones relacionadas