VB Utf-8 转 Unicode

作者:admin 日期:2008-04-15

字体大小: 小中大

Function Utf8ToUnicode(ByRef sDest As String, ByVal MaxDestChars As Long, _
      ByRef Source() As Byte, ByVal SourceBytes As Long) As Long
      Dim i As Long, count As Long
      Dim c As Byte
      Dim wc As Long
      Dim Dest() As Byte
      ＇Dim Source() As Byte

      ＇If sSource = "" Then
      ＇  Utf8ToUnicode = 0
      ＇  Exit Function
      ＇End If

      Utf8ToUnicode = -1
      count = 0
      i = 0

      If sDest <> "" Then
        ＇Source = sSource
        ReDim Dest(MaxDestChars * 2 + 1)
        While (i < SourceBytes) And (count < MaxDestChars)

          wc = Source(i)
          i = i + 1
          If (wc And &H80&) <> 0 Then

            If i >= SourceBytes Then Exit Function          ＇// incomplete multibyte char
            wc = wc And &H3F&
            If (wc And &H20&) <> 0 Then

              c = Source(i)
              i = i + 1
              If (c And &HC0&) <> &H80& Then Exit Function      ＇// malformed trail byte or out of range char
              If i >= SourceBytes Then Exit Function        ＇// incomplete multibyte char
              wc = (wc * (2 ^ 6)) or (c And &H3F&)
            End If
            c = Source(i)
            i = i + 1
            If (c And &HC0&) <> &H80& Then Exit Function       ＇// malformed trail byte
            Dest(count * 2 + 1) = (((wc * (2 ^ 6)) or (c And &H3F&)) And &HFF00&) \ (2 ^ 8)
            Dest(count * 2) = ((wc * (2 ^ 6)) or (c And &H3F&)) And &HFF&
          Else
            Dest(count * 2 + 1) = (wc And &HFF00&) \ (2 ^ 8)
            Dest(count * 2) = wc And &HFF&
          End If
          count = count + 1
        Wend
        If count >= MaxDestChars Then count = MaxDestChars - 1
        Dest(count * 2) = 0
        Dest(count * 2 + 1) = 0

      Else

        While (i < SourceBytes)

          c = Source(i)
          i = i + 1
          If (c And &H80&) <> 0 Then

            If i >= SourceBytes Then Exit Function          ＇// incomplete multibyte char
            c = c And &H3F&
            If (c And &H20&) <> 0 Then

              c = Source(i)
              i = i + 1
              If (c And &HC0&) <> &H80& Then Exit Function      ＇// malformed trail byte or out of range char
              If i >= SourceBytes Then Exit Function        ＇// incomplete multibyte char
            End If
            c = Source(i)
            i = i + 1
            If (c And &HC0&) <> &H80& Then Exit Function       ＇// malformed trail byte
          End If
          count = count + 1
        Wend
      End If
      ReDim Preserve Dest(count)
      sDest = Dest
      Utf8ToUnicode = Len(sDest)
End Function
Private Function Utf8Decode(s As String) As String
  Dim L As Integer
  Dim Temp As String
  Dim Src() As Byte
  Src = s
  Utf8Decode = ""
  If s = "" Then Exit Function

  Temp = String((UBound(Src) + 1) * 2, vbNullChar)


  L = Utf8ToUnicode(Temp, (UBound(Src) + 1) * 2 + 1, Src, (UBound(Src) + 1))
  If L > 0 Then
    Temp = Left(Temp, L - 1)
  Else
    Temp = ""
  End If
  Utf8Decode = Temp
End Function

上面的代碼轉換出來的是Unicode,其實對於是否GBK/GB2312碼就不重要了,即使是其它編碼也適用,主要是需要本機支持,如果確實需要GB碼,則可以使用
StrConv(GB2312_String,vbFromUnicode,&H804)