vbCoders Guest



Don't have an account yet? Register
 


Forgot Password?



HTML Decoder (Unicode)

by htmlcoder (1 Submission)
Category: Internet/HTML
Compatability: ASP (Active Server Pages)
Difficulty: Beginner
Date Added: Sat 1st January 2022
Rating: (1 Votes)

HTML Decode. The reverse of the htmlencode. Now with unicode and emoji support

Rate HTML Decoder (Unicode)

 <%
    Option Explicit

    Dim objHelper
    Set objHelper = New HtmlEntityToUnicode

    Response.Write(objHelper.HtmlDecode("<br/><br/>hi  💚 green heart! purple heart 💜 ! "))

    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, """, 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, "\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


    %>

Download Snippet Download this snippet   Add to My Save List Add to My Saved Code

HTML Decoder (Unicode) Comments

No comments have been posted about HTML Decoder (Unicode). Why not be the first to post a comment about HTML Decoder (Unicode).

Post your comment

Subject:
Message:
0/1000 characters