slore

...UTF-8编码...

slore

MsgBox UTF8Encode("我是Slore")

Public Function UTF8Encode(szString)
    Dim szChar,szTemp,szCode
    Dim szHex,szBin
    Dim iCount1,iCount2
    Dim iStrLen1,iStrLen2
    Dim lResult
    Dim lAscVal
    szString = Trim(szString)
    iStrLen1 = Len(szString)
    For iCount1 = 1 To iStrLen1
        szChar = Mid(szString, iCount1, 1)
        lAscVal = AscW(szChar)
        If lAscVal >= &H0 And lAscVal <= &HFF Then
            If (lAscVal >= &H30 And lAscVal <= &H39) Or _
                (lAscVal >= &H41 And lAscVal <= &H5A) Or _
                 (lAscVal >= &H61 And lAscVal <= &H7A) Then
                szCode = szCode & szChar
            Else
                szCode = szCode & "%" & Hex(AscW(szChar))
            End If
        Else
            szHex = Hex(AscW(szChar))
            iStrLen2 = Len(szHex)
            For iCount2 = 1 To iStrLen2
                szChar = Mid(szHex, iCount2, 1)
                szBin = szBin & Mid("0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;", CLng("&H" & szChar) * 5 + 1, 4)
            Next
            szTemp = "1110" & Left(szBin, 4) & "10" & Mid(szBin, 5, 6) & "10" & Right(szBin, 6)
            For iCount2 = 1 To 24
                If Mid(szTemp, iCount2, 1) = "1" Then
                    lResult = lResult + 1 * 2 ^ (24 - iCount2)
                    Else: lResult = lResult + 0 * 2 ^ (24 - iCount2)
                End If
            Next
            szTemp = Hex(lResult)
            szCode = szCode & "%" & Left(szTemp, 2) & "%" & Mid(szTemp, 3, 2) & "%" & Right(szTemp, 2)
        End If
        szBin = vbNullString
        lResult = 0
    Next
    UTF8Encode = szCode
End Function
复制代码