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 SelectEnd SubFunction 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 NextEnd FunctionFunction 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 LoopEnd Function
