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

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 500 Downloads 215

'UTF8', 'UTF-8', 'Encode', 'Decode', 'NotMyWork', 'Convert', 'replace', 'substitute', 'change'

ANmarAmdeen
326
Texts + Strings Classic ASP
Revisions

v1.0