- 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
复制代码
|