Option Explicit
'Author: Nguyen Duy Tuan
'Website: https://bluesofts.net/daotaothuchanh/lap-trinh-vba-co-ban-tao-macro.html
#If VBA7 Then
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long ) As Long
#Else
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 cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) 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
#End If
Private Const CP_UTF8 = 65001
Function LenUTF8(UnicodeStr As String) As Long
Dim b() As Byte
b = UnicodeStrToUTF8Bytes(UnicodeStr)
LenUTF8 = UBound(b) - LBound(b) + 1
End Function
Public Function UnicodeStrToUTF8Bytes(UnicodeStr As String) As Byte()
Dim nBytes As Long
Dim Buffer() As Byte
UnicodeStrToUTF8Bytes = vbNullString
If Len(UnicodeStr) < 1 Then Exit Function
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(UnicodeStr), -1, 0&, 0&, 0&, 0&)
ReDim Buffer(nBytes - 2)
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(UnicodeStr), -1, ByVal VarPtr(Buffer(0)), nBytes - 1, 0&, 0&)
UnicodeStrToUTF8Bytes = Buffer
End Function
|