vb 如何将十六进制UTF-8转换为汉字

时间:2022-05-07 10:57:15
据说java语言是这样的,那VB呢?

byte[] b(byte)0x62,(byte)0x11,(byte)0x72,(byte)0x31};
  try {
 System.out.println(new String(b,"UTF-16"));
  } catch (UnsupportedEncodingException e) {
 e.printStackTrace();
  } 

6 个解决方案

#1


可以借助 ADO.Stream。

#2



Private Sub Command1_Click()
    Dim a As String
    x = "E3809053696D656EE38091E78E89E69E973C3C3C2A412E6C7379E68898E9989FE8BF9EE8B7B3E69C8DE58AA1E599A8"
    Debug.Print iGB(x)
End Sub


Function iGB(ByVal iHex As String) As String
      Dim b As Integer
      For i = 1 To Len(iHex) Step 2
          a = a & "%" & Mid(iHex, i, 2)
      Next
      For i = 1 To Len(a)
          b = Replace(Mid(a, i, 3), "%", "&H")
          If b < Val("&H80") Then
             Mid(a, i, 3) = Chr(b) & "  "
             i = i + 2
          Else
             i = i + 8
          End If
      Next
      a = Replace(a, "  ", "")
      iGB = UTF2GB(a)
End Function

Function UTF2GB(UTFStr)
For Dig = 1 To Len(UTFStr)
    If Mid(UTFStr, Dig, 1) = "%" Then
        If Len(UTFStr) >= Dig + 8 Then
            GBStr = GBStr & ConvChinese(Mid(UTFStr, Dig, 9))
            Dig = Dig + 8
        Else
            GBStr = GBStr & Mid(UTFStr, Dig, 1)
        End If
    Else
        GBStr = GBStr & Mid(UTFStr, Dig, 1)
    End If
Next
UTF2GB = GBStr
End Function

Function ConvChinese(x)
a = Split(Mid(x, 2), "%")
i = 0
j = 0

For i = 0 To UBound(a)
a(i) = c16to2(a(i))
Next

For i = 0 To UBound(a) - 1
    DigS = InStr(a(i), "0")
    Unicode = ""

For j = 1 To DigS - 1
If j = 1 Then
a(i) = Right(a(i), Len(a(i)) - DigS)
Unicode = Unicode & a(i)
Else
i = i + 1
a(i) = Right(a(i), Len(a(i)) - 2)
Unicode = Unicode & a(i)
End If
Next

If Len(c2to16(Unicode)) = 4 Then
ConvChinese = ConvChinese & ChrW(Int("&H" & c2to16(Unicode)))
Else
ConvChinese = ConvChinese & Chr(Int("&H" & c2to16(Unicode)))
End If
Next
End Function

Function c2to16(x)
i = 1
For i = 1 To Len(x) Step 4
c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
Next
End Function

Function c2to10(x)
c2to10 = 0
If x = "0" Then Exit Function
i = 0
For i = 0 To Len(x) - 1
If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
Next
End Function

Function c16to2(x)
i = 0
For i = 1 To Len(Trim(x))
tempstr = c10to2(CInt(Int("&h" & Mid(x, i, 1))))
Do While Len(tempstr) < 4
tempstr = "0" & tempstr
Loop
c16to2 = c16to2 & tempstr
Next
End Function

Function c10to2(x)
mysign = Sgn(x)
x = Abs(x)
DigS = 1
Do
If x < 2 ^ DigS Then
Exit Do
Else
DigS = DigS + 1
End If
Loop
tempnum = x

i = 0
For i = DigS To 1 Step -1
If tempnum >= 2 ^ (i - 1) Then
tempnum = tempnum - 2 ^ (i - 1)
c10to2 = c10to2 & "1"
Else
c10to2 = c10to2 & "0"
End If
Next
If mysign = -1 Then c10to2 = "-" & c10to2
End Function

#3


Sub Main()
    Dim b() As Byte
    
    ReDim b(5)
    b(0) = &HE4
    b(1) = &HB8
    b(2) = &HAD
    b(3) = &HE6
    b(4) = &H96
    b(5) = &H87
    Debug.Print StrFromUtf8(b)
End Sub

Function StrFromUtf8(Utf8() As Byte) As String
    Dim aBOM() As Byte
    
    ReDim aBOM(2)
    aBOM(0) = &HEF
    aBOM(1) = &HBB
    aBOM(2) = &HBF
    
    Dim oStream As ADODB.Stream
    
    Set oStream = New ADODB.Stream
    oStream.Open
    
    oStream.Type = adTypeBinary
    oStream.Write aBOM
    oStream.Write Utf8
    
    oStream.Position = 0
    oStream.Type = adTypeText
    oStream.Charset = "UTF-8"
    StrFromUtf8 = oStream.ReadText()
    
    oStream.Close
End Function

#4


通过修改 CharSet 可以变成 UTF-16 的转换。

#6


该回复于2010-03-12 11:38:59被版主删除

#1


可以借助 ADO.Stream。

#2



Private Sub Command1_Click()
    Dim a As String
    x = "E3809053696D656EE38091E78E89E69E973C3C3C2A412E6C7379E68898E9989FE8BF9EE8B7B3E69C8DE58AA1E599A8"
    Debug.Print iGB(x)
End Sub


Function iGB(ByVal iHex As String) As String
      Dim b As Integer
      For i = 1 To Len(iHex) Step 2
          a = a & "%" & Mid(iHex, i, 2)
      Next
      For i = 1 To Len(a)
          b = Replace(Mid(a, i, 3), "%", "&H")
          If b < Val("&H80") Then
             Mid(a, i, 3) = Chr(b) & "  "
             i = i + 2
          Else
             i = i + 8
          End If
      Next
      a = Replace(a, "  ", "")
      iGB = UTF2GB(a)
End Function

Function UTF2GB(UTFStr)
For Dig = 1 To Len(UTFStr)
    If Mid(UTFStr, Dig, 1) = "%" Then
        If Len(UTFStr) >= Dig + 8 Then
            GBStr = GBStr & ConvChinese(Mid(UTFStr, Dig, 9))
            Dig = Dig + 8
        Else
            GBStr = GBStr & Mid(UTFStr, Dig, 1)
        End If
    Else
        GBStr = GBStr & Mid(UTFStr, Dig, 1)
    End If
Next
UTF2GB = GBStr
End Function

Function ConvChinese(x)
a = Split(Mid(x, 2), "%")
i = 0
j = 0

For i = 0 To UBound(a)
a(i) = c16to2(a(i))
Next

For i = 0 To UBound(a) - 1
    DigS = InStr(a(i), "0")
    Unicode = ""

For j = 1 To DigS - 1
If j = 1 Then
a(i) = Right(a(i), Len(a(i)) - DigS)
Unicode = Unicode & a(i)
Else
i = i + 1
a(i) = Right(a(i), Len(a(i)) - 2)
Unicode = Unicode & a(i)
End If
Next

If Len(c2to16(Unicode)) = 4 Then
ConvChinese = ConvChinese & ChrW(Int("&H" & c2to16(Unicode)))
Else
ConvChinese = ConvChinese & Chr(Int("&H" & c2to16(Unicode)))
End If
Next
End Function

Function c2to16(x)
i = 1
For i = 1 To Len(x) Step 4
c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
Next
End Function

Function c2to10(x)
c2to10 = 0
If x = "0" Then Exit Function
i = 0
For i = 0 To Len(x) - 1
If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
Next
End Function

Function c16to2(x)
i = 0
For i = 1 To Len(Trim(x))
tempstr = c10to2(CInt(Int("&h" & Mid(x, i, 1))))
Do While Len(tempstr) < 4
tempstr = "0" & tempstr
Loop
c16to2 = c16to2 & tempstr
Next
End Function

Function c10to2(x)
mysign = Sgn(x)
x = Abs(x)
DigS = 1
Do
If x < 2 ^ DigS Then
Exit Do
Else
DigS = DigS + 1
End If
Loop
tempnum = x

i = 0
For i = DigS To 1 Step -1
If tempnum >= 2 ^ (i - 1) Then
tempnum = tempnum - 2 ^ (i - 1)
c10to2 = c10to2 & "1"
Else
c10to2 = c10to2 & "0"
End If
Next
If mysign = -1 Then c10to2 = "-" & c10to2
End Function

#3


Sub Main()
    Dim b() As Byte
    
    ReDim b(5)
    b(0) = &HE4
    b(1) = &HB8
    b(2) = &HAD
    b(3) = &HE6
    b(4) = &H96
    b(5) = &H87
    Debug.Print StrFromUtf8(b)
End Sub

Function StrFromUtf8(Utf8() As Byte) As String
    Dim aBOM() As Byte
    
    ReDim aBOM(2)
    aBOM(0) = &HEF
    aBOM(1) = &HBB
    aBOM(2) = &HBF
    
    Dim oStream As ADODB.Stream
    
    Set oStream = New ADODB.Stream
    oStream.Open
    
    oStream.Type = adTypeBinary
    oStream.Write aBOM
    oStream.Write Utf8
    
    oStream.Position = 0
    oStream.Type = adTypeText
    oStream.Charset = "UTF-8"
    StrFromUtf8 = oStream.ReadText()
    
    oStream.Close
End Function

#4


通过修改 CharSet 可以变成 UTF-16 的转换。

#5


#6


该回复于2010-03-12 11:38:59被版主删除