GOOLE只接收UTF编码,下面是把汉字转化为UTF和把UTF转化为汉字的代码,贴出来与大家共享.
Option Explicit
Private Sub Command1_Click()
Select Case True
Case Len(Text1.Text) <> 0
Text2.Text = UTF2USC(Text1.Text)
Case Len(Text2.Text) <> 0
If Len(Text2.Text) = LenB(Text2.Text) Then
Text1.Text = Text2.Text
Else
Text1.Text = USC2UTF8(Text2.Text)
End If
Case Else
MsgBox "PLEASE INPUT STRING", 48
End Select
End Sub
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
Function UTF2USC(ByVal UTF As String) As String 'UTF-8转换为汉字
Dim i As Integer: i = 1
Dim Str_Asc As String
Dim DAT(2) As Byte '存放UTF-8数据
Dim DAT1(1) As Byte '存放原始字节数据，1汉字需要4个数租元素
Dim ST As String
Do While i < Len(UTF)
Str_Asc = Mid(UTF, i, 1)
If Asc(Str_Asc) < 128 Then
UTF2USC = UTF2USC & Str_Asc
i = i + 1
Else
DAT(0) = CByte("&H" + Mid(UTF, i, 2))
DAT(1) = CByte("&H" + Mid(UTF, i + 2, 2))
DAT(2) = CByte("&H" + Mid(UTF, i + 4, 2))
DAT1(1) = ((DAT(0) And 15) * 16 + (DAT(1) And 60) / 4)
DAT1(0) = (DAT(1) And 3) * 64 + (DAT(2) And 63)
i = i + 6
'高位低位需要互换
UTF2USC = UTF2USC & ChrW("&H" + CStr(Hex(DAT1(1))) + CStr(Hex(DAT1(0))))
End If
Loop
End Function