IsValidUTF8 + DecodeUTF8 + EncodeUTF8

Checks UTF8, or convert to/from UTF8. Simple functions to convert the first 256 characters of the Windows character set from and to UTF-8.
Written by Hans Kalle for Fisz http://www.fisz.nl
IsValidUTF8: Tells if the string is valid UTF-8 encoded, returns true (valid UTF-8) or false (invalid UTF-8 or not UTF-8 encoded string)
DecodeUTF8: Decodes a UTF-8 string to the Windows character set Non-convertable characters are replaced by an upside down question mark. returns A Windows string
EncodeUTF8: Encodes a Windows string in UTF-8, returns: A UTF-8 encoded string

CodeFunctionName
What is this?

Public

Tested

Imported
Function IsValidUTF8(s)
dim i, c, n
IsValidUTF8 = false
i = 1
Do While i <= len(s)
c = Asc(Mid(s,i,1))
If c And &H80 Then
n = 1
Do While i + n < len(s)
If (asc(mid(s,i+n,1)) and &HC0) < > &H80 Then
Exit Do
End if
n = n + 1
Loop
Select Case n
Case 1
Exit Function
Case 2
If (c and &HE0) < > &HC0 Then Exit Function
Case 3
If (c and &HF0) < > &HE0 Then Exit Function
Case 4
If (c and &HF8) < > &HF0 Then Exit Function
Case Else
Exit Function
End Select
i = i + n
Else
i = i + 1
End if
Loop
IsValidUTF8 = true
End Function

Function DecodeUTF8(s)
Dim i, c, n
i = 1
Do While i <= len(s)
c = Asc(Mid(s,i,1))
If c and &H80 Then
n = 1
Do While i + n < len(s)
If (asc(mid(s,i+n,1)) and &HC0) < > &H80 Then Exit do
n = n + 1
Loop
If n = 2 And ((c And &HE0) = &HC0) Then
c = asc(mid(s,i+1,1)) + &H40 * (c and &H01)
Else
c = 191
End If
s = left(s,i-1) + chr(c) + mid(s,i+n)
End If
i = i + 1
Loop
DecodeUTF8 = s
End Function

Function EncodeUTF8(s)
Dim i, c
i = 1
Do While i <= len(s)
c = asc(mid(s,i,1))
If c >= &H80 Then
s = left(s,i-1) + chr(&HC2 + ((c and &H40) / &H40)) + chr(c and &HBF) + mid(s,i+1)
i = i + 1
End If
i = i + 1
Loop
EncodeUTF8 = s
End Function

s

Views 3,690

Downloads 1,412

CodeID
DB ID