Option Compare Binary
Option Explicit
 
 
'-------------------------------------------------------------------------
' Konstanten
'-------------------------------------------------------------------------
Private Const CP_ACP = 0
Private Const CP_UTF8 = 65001
 
 
'-------------------------------------------------------------------------
' API-Deklarationen
'-------------------------------------------------------------------------
Private Declare Function GetACP Lib "kernel32" () As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As _
  Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte _
  As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As _
Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As _
Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal _
lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
 
 
 
'-------------------------------------------------------------------------
' DecodeUTF8
'-------------------------------------------------------------------------
Public Function DecodeUTF8(ByVal sValue As String) As String
 
  If Len(sValue) = 0 Then Exit Function
  DecodeUTF8 = WToA(sValue, CP_ACP)
  DecodeUTF8 = AToW(DecodeUTF8, CP_UTF8)
 
End Function
 
 
'-------------------------------------------------------------------------
' EncodeUTF8
'-------------------------------------------------------------------------
Public Function EncodeUTF8(ByVal sValue As String) As String
 
  If Len(sValue) = 0 Then Exit Function
  EncodeUTF8 = StrConv(WToA(sValue, CP_UTF8), vbUnicode)
 
End Function
 
 
'-------------------------------------------------------------------------
'   WToA
'   UNICODE to ANSI conversion, via a given codepage
'-------------------------------------------------------------------------
Private Function WToA(ByVal sValue As String, Optional ByVal cpg As Long = -1, _
  Optional ByVal lFlags As Long = 0) As String
Dim cwch              As Long
Dim pwz               As Long
Dim pwzBuffer         As Long
Dim sBuffer           As String
 
  If cpg = -1 Then cpg = GetACP()
  pwz = StrPtr(sValue)
  cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
  sBuffer = String$(cwch + 1, vbNullChar)
  pwzBuffer = StrPtr(sBuffer)
  cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(sBuffer), _
    ByVal 0&, ByVal 0&)
  WToA = Left$(sBuffer, cwch - 1)
 
End Function
 
 
'-------------------------------------------------------------------------
'   AToW
'   ANSI to UNICODE conversion, via a given codepage.
'-------------------------------------------------------------------------
Private Function AToW(ByVal sValue As String, Optional ByVal cpg As Long = -1, _
  Optional ByVal lFlags As Long = 0) As String
Dim cwch      As Long
Dim pwz       As Long
Dim pwzBuffer As Long
Dim sBuffer   As String
 
  If cpg = -1 Then cpg = GetACP()
  pwz = StrPtr(sValue)
  cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
  sBuffer = String$(cwch + 1, vbNullChar)
  pwzBuffer = StrPtr(sBuffer)
  cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(sBuffer))
  AToW = Left$(sBuffer, cwch - 1)
 
End Function

Mfg
CyberDreams