51Testing软件测试论坛

标题: Unicode 转UTF8 [打印本页]

作者: ganlixiong    时间: 2007-11-15 10:33
标题: Unicode 转UTF8
QTP里有没有函数或方法进行编码转换的?想把Unicode 转UTF8,没搞过,求9来了
作者: ganlixiong    时间: 2007-11-15 14:10
'Utf8 转换为 Unicode
Public Function UTF8_Decode(ByVal s As String) As String

Dim lUtf8Size As Long
Dim sBuffer As String
Dim lBufferSize As Long
Dim lResult As Long
Dim b() As Byte

If LenB(s) Then
On Error GoTo EndFunction
b = StrConv(s, vbFromUnicode)
lUtf8Size = UBound(b) + 1
On Error GoTo 0
'Set buffer for longest possible string i.e. each byte is
'ANSI<=&HFF, thus 1 unicode(2 bytes)for every utf-8 character.
lBufferSize = lUtf8Size * 2
sBuffer = String$(lBufferSize, vbNullChar)
'Translate using code page 65001(UTF-8)
lResult = MultiByteToWideChar(CP_UTF8, 0, b(0), _
lUtf8Size, StrPtr(sBuffer), lBufferSize)
'Trim result to actual length
If lResult Then
UTF8_Decode = Left$(sBuffer, lResult)
'Debug.Print UTF8_Decode
End If
End If

EndFunction:

End Function



'Unicode转换为UTF-8.
Public Function UTF8_Encode(ByVal strUnicode As String) As String 'ByVal strUnicode As Byte
Dim TLen As Long

TLen = Len(strUnicode)
If TLen = 0 Then Exit Function

Dim lBufferSize As Long
Dim lResult As Long
Dim b() As Byte
'Set buffer for longest possible string.
lBufferSize = TLen * 3 + 1
ReDim b(lBufferSize - 1)
'Translate using code page 65001(UTF-8).
lResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), _
TLen, b(0), lBufferSize, vbNullString, 0)
'Trim result to actual length.
If lResult Then
lResult = lResult - 1
ReDim Preserve b(lResult)
UTF8_Encode = StrConv(b, vbUnicode)
End If

End Function
作者: ganlixiong    时间: 2007-11-15 15:18
WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), _
TLen, b(0), lBufferSize, vbNullString, 0)

WideCharToMultiByte,StrPtr 这两个函数QTP不认识,怎么处理,高手出来一下阿
作者: ganlixiong    时间: 2007-11-16 10:24
不能沉啊,坚持到周末,看看有大黑们出手不, 只要能在QTP下进行转换的有效方法,我给分20分啊,
作者: ganlixiong    时间: 2007-11-16 15:09
Function Unicode2Chr(byval str)
        Dim st, t, i
        For i = 1 To Len(str)/4
                t = Mid(str, 4*i-3, 4)
                t = Mid(t, 3) & Left(t, 2)
                t = ChrW(Hex2Dec(t))
                st = st & t
        Next
        Unicode2Chr = st
End Function

Function Hex2Dec(byval str)
        Dim i, j, k, result
        result = 0
        For i = 1 To Len(str)
                Select Case Mid(str, i, 1)
                        Case "F": j = 15
                        Case "E": j = 14
                        Case "D": j = 13
                        Case "C": j = 12
                        Case "B": j = 11
                        Case "A": j = 10
                        Case Else: If Mid(str, i, 1) <= "9" And Mid(str, i, 1) >= "0" Then j = CInt(Mid(str, i, 1))
                End Select
                For k = 1 To Len(str) - i
                        j = j * 16
                Next
                result = result + j
        Next
        Hex2Dec = result
End Function


自问自答




欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/) Powered by Discuz! X3.2