Source language: Translate to:

UTF8 to ANSI

Questions and information about using VBScript and JavaScript in NeoBook functions

Moderator: Neosoft Support

UTF8 to ANSI

Postby David de Argentina » Tue Aug 06, 2013 11:20 am

Save into the Functions Folder:

Code: Select all
{NeoBook Function}
Version=5.80
Language=VBScript
Param=[%1]|Text|Input UTF8 Variable
Param=[%2]|Variable|Return ANSI Variable
{End}
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext

    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function

Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext

    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If

    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If

        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop

    Decode_UTF8 = unitext
End Function

Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n

    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If

        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function


publication.nbSetVar "[%2]", Decode_UTF8("[%1]")


Greetings from Buenos Aires,
David de Argentina
User avatar
David de Argentina
 
Posts: 1553
Joined: Mon Apr 04, 2005 4:13 pm
Location: Buenos Aires, Argentina

Re: UTF8 to ANSI

Postby Neosoft Support » Wed Aug 07, 2013 10:07 am

Thanks David!
NeoSoft Support
Neosoft Support
NeoSoft Team
 
Posts: 5593
Joined: Thu Mar 31, 2005 10:48 pm
Location: Oregon, USA

Re: UTF8 to ANSI

Postby Rasl » Wed Aug 07, 2013 1:08 pm

Thanks David!

salu2
Rasl
 
Posts: 129
Joined: Sat Apr 02, 2005 8:25 am
Location: Buenos Aires, Argentina


Return to NeoBook Functions - VBScript & JavaScript

Who is online

Users browsing this forum: No registered users and 1 guest