IT Pro Darkst

• 其他检索
• 其他资料
• 基础软件资料
• 开发相关资料
• 硬件相关资料
• 网络相关资料
• 默认分类

• ASP
• HTML
• JS
• PHP
• VB
• VBS

【转】VBS - 十六进制 UTF-8 码转 GB 字符

Function UTF8Code2GBChar(str)
    Dim n, gbstr
    For n = 1 To Len(str)
        If Mid(str, n, 1) = "%" Then
            If Len(str) >= n + 8 Then        ' 使用 UTF-8 编码的字符一般都占 3 字节（%XX%XX%XX）
                gbstr = gbstr & SingleGBChar(Mid(str, n, 9))
                n = n + 8
            Else
                gbstr = gbstr & Mid(str, n, 1)
            End If
        Else
            gbstr = gbstr & Mid(str, n, 1)
        End If
    Next
    UTF8Code2GBChar = gbstr
End Function

Function SingleGBChar(x)
    Dim A, i, j, digs, unicode
 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
            SingleGBChar = SingleGBChar & ChrW(Int("&H" & c2to16(unicode)))
        Else
            SingleGBChar = SingleGBChar & Chr(Int("&H" & c2to16(unicode)))
        End If
    Next
End Function

Function c2to16(x)
    Dim i
 i = 1
    For i = 1 To Len(x) Step 4
        c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
    Next
End Function
   
Function c2to10(x)
    Dim i
 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)
    Dim i, tempstr
 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)
    Dim mysign, digs, tempnum, i
 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