Option ExplicitPrivate Const CP_ACP = 0 ' default to ANSI code pagePrivate Const CP_UTF8 = 65001 ' default to UTF-8 code pagePrivate 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 LongPrivate 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, ByVal lpUsedDefaultChar As Long) As LongPrivate Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0 Dim aRetn() As Byte Dim nSize As Long
EncodeToString = aRetn End FunctionPrivate Function EncodeToString(ByVal sData As String) As String ' Note: Len(sData) > 0 Dim sRetn As String Dim aData() As Byte Dim nSize As Long Dim sChar As String Dim i As Long
nSize = WideCharToMultiByte(CP_ACP, 0, StrPtr(sData), -1, 0, 0, 0, 0) ReDim aData(0 To nSize - 1) As Byte WideCharToMultiByte CP_ACP, 0, StrPtr(sData), -1, VarPtr(aData(0)), nSize, 0, 0 sRetn = "" For i = 0 To UBound(aData) - 1 sChar = Hex(aData(i)) If Len(sChar) = 1 Then sChar = 0 & sChar sRetn = sRetn & "%" & sChar Next
EncodeToString = sRetn End Function
Private Sub Command1_Click() MsgBox USC2UTF8("test试验") End SubPrivate Function USC2UTF8(ByVal HZ As String) As String '汉字换为UTF-8 Dim i As Integer Dim str_Char As String Dim DAT(2) As Byte '存放UTF-8数据 Dim DAT1() As Byte '存放原始字节数据,1汉字需要4个数租元素 USC2UTF8 = vbNullString For i = 1 To Len(HZ) str_Char = Mid(HZ, i, 1) '判断是不是汉字 If AscW(str_Char) > &H0 And AscW(str_Char) < &H800 Then USC2UTF8 = USC2UTF8 & str_Char Else '按照 FFFF FFFF转换为二进制的 1110xxxx 10xxxxxx 10xxxxxx’高位低位也要互换 ReDim DAT1(1) As Byte DAT1 = str_Char 'DAT1变成两个元素的数租 DAT(0) = (DAT1(1) And 240) / 16 Or 224 '将第一个字节取前4位进行 1110+ DAT(1) = (DAT1(1) And 15) * 4 + ((DAT1(0) And 192) / 64) Or 128 '将第1个字节后四位进行 10+,连接第2字节前两位 DAT(2) = DAT1(0) And 63 Or 128 '10连接 第2位后两位连接和第三位 USC2UTF8 = USC2UTF8 & CStr(Hex(DAT(0))) + CStr(Hex(DAT(1))) + CStr(Hex(DAT(2))) End If Next End Function
Public Function strToUTF8(ByVal str As String) As Byte() Dim I As Integer Dim zAsc As Long 'Ascii码暂存 Dim L As Long '字节计数 Dim dat2() As Byte, dat3() As Byte Dim zz As String ''''ReDim dat2(2) As Byte ''''dat2(0) = &HEF: dat2(1) = &HBB: dat2(2) = &HBFFor I = 1 To Len(str) zz = Mid(str, I, 1): zAsc = Asc(zz) If zAsc > 0 Then '如果不是汉字 ReDim Preserve dat2(L + 1) As Byte dat2(L) = zAsc: L = L + 1 Else ReDim Preserve dat2(L + 3) As Byte dat3 = zz dat2(L) = (dat3(1) And 240) / 16 Or 224 dat2(L + 1) = (dat3(1) And 15) * 4 + ((dat3(0) And 192) / 64) Or 128 dat2(L + 2) = dat3(0) And 63 Or 128 L = L + 3 End If Next strToUTF8 = dat2End Function
Option ExplicitPrivate Const CP_ACP = 0 ' default to ANSI code pagePrivate Const CP_UTF8 = 65001 ' default to UTF-8 code pagePrivate 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 LongPrivate 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, ByVal lpUsedDefaultChar As Long) As LongPrivate Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0 Dim aRetn() As Byte Dim nSize As Long
EncodeToBytes = aRetn End FunctionPrivate Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0 Dim aRetn() As Byte Dim nSize As Long
DecodeToBytes = aRetn End FunctionPrivate Sub Command1_Click() Dim s As String s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode) MsgBox s s = DecodeToBytes(StrConv(s, vbFromUnicode)) MsgBox s End Sub
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToString = aRetn
End FunctionPrivate Function EncodeToString(ByVal sData As String) As String ' Note: Len(sData) > 0
Dim sRetn As String
Dim aData() As Byte
Dim nSize As Long
Dim sChar As String
Dim i As Long
nSize = WideCharToMultiByte(CP_ACP, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aData(0 To nSize - 1) As Byte
WideCharToMultiByte CP_ACP, 0, StrPtr(sData), -1, VarPtr(aData(0)), nSize, 0, 0
sRetn = ""
For i = 0 To UBound(aData) - 1
sChar = Hex(aData(i))
If Len(sChar) = 1 Then sChar = 0 & sChar
sRetn = sRetn & "%" & sChar
Next
EncodeToString = sRetn
End Function
MsgBox USC2UTF8("test试验")
End SubPrivate Function USC2UTF8(ByVal HZ As String) As String '汉字换为UTF-8
Dim i As Integer
Dim str_Char As String
Dim DAT(2) As Byte '存放UTF-8数据
Dim DAT1() As Byte '存放原始字节数据,1汉字需要4个数租元素
USC2UTF8 = vbNullString
For i = 1 To Len(HZ)
str_Char = Mid(HZ, i, 1) '判断是不是汉字
If AscW(str_Char) > &H0 And AscW(str_Char) < &H800 Then
USC2UTF8 = USC2UTF8 & str_Char
Else '按照 FFFF FFFF转换为二进制的 1110xxxx 10xxxxxx 10xxxxxx’高位低位也要互换
ReDim DAT1(1) As Byte
DAT1 = str_Char 'DAT1变成两个元素的数租
DAT(0) = (DAT1(1) And 240) / 16 Or 224 '将第一个字节取前4位进行 1110+
DAT(1) = (DAT1(1) And 15) * 4 + ((DAT1(0) And 192) / 64) Or 128 '将第1个字节后四位进行 10+,连接第2字节前两位
DAT(2) = DAT1(0) And 63 Or 128 '10连接 第2位后两位连接和第三位
USC2UTF8 = USC2UTF8 & CStr(Hex(DAT(0))) + CStr(Hex(DAT(1))) + CStr(Hex(DAT(2)))
End If
Next
End Function
Dim I As Integer
Dim zAsc As Long 'Ascii码暂存
Dim L As Long '字节计数
Dim dat2() As Byte, dat3() As Byte
Dim zz As String
''''ReDim dat2(2) As Byte
''''dat2(0) = &HEF: dat2(1) = &HBB: dat2(2) = &HBFFor I = 1 To Len(str)
zz = Mid(str, I, 1): zAsc = Asc(zz)
If zAsc > 0 Then '如果不是汉字
ReDim Preserve dat2(L + 1) As Byte
dat2(L) = zAsc: L = L + 1
Else
ReDim Preserve dat2(L + 3) As Byte
dat3 = zz
dat2(L) = (dat3(1) And 240) / 16 Or 224
dat2(L + 1) = (dat3(1) And 15) * 4 + ((dat3(0) And 192) / 64) Or 128
dat2(L + 2) = dat3(0) And 63 Or 128
L = L + 3
End If
Next
strToUTF8 = dat2End Function
要求将字符串
"aa中文aa" 转成 "aa涓枃aa"java代码如下:
String str = "aa中文aa";
System.out.print(new String(str.getBytes("UTF-8")));我在VB如何作?
另外感谢楼上的。但是你写的第一个函数EncodeToBytes就有错误
EncodeToString = aRetn
应该修改为:
EncodeToBytes = aRetn而且我没法用你这个函数得到我要的结果。
Dim s As String
s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode)
MsgBox s
End Sub
Hassle()与zq972(热)→(大·汗·天·子) 的都是可以的
怪我没有使用 StrConv(EncodeToBytes("aa中文aa"), vbUnicode)进行转换谢谢。
顺便问一下。如果我读取的信息是"aa涓枃aa"
如何将他转换成"aa中文aa"谢谢
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End FunctionPrivate Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End FunctionPrivate Sub Command1_Click()
Dim s As String
s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode)
MsgBox s
s = DecodeToBytes(StrConv(s, vbFromUnicode))
MsgBox s
End Sub