unicode转utf不完整 为什么啊 奉上代码
Option ExplicitPublic Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Const CP_UTF8 = 65001
'UTF-8转换为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
'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 * 3
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
不知道那里错了 很多汉字转不了 比如 中华人民共和国就出 乱码
不知道上面的代码那里错了 --------------------编程问答-------------------- 帮楼主顶顶..... --------------------编程问答-------------------- 一般中文还可以处理 但是到了中英混合特殊符号 就转换不成功了 --------------------编程问答-------------------- 按照MSDN的说明做了一个，你可以参考：
Option Explicit--------------------编程问答-------------------- 问题可能出在这里
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Sub Command1_Click()
'UTF-8：61 e4 b8 ad e5 9b bd 2c 62 63
'a中国,bc
Dim UTF8(9) As Byte
UTF8(0) = &H61
UTF8(1) = &HE4
UTF8(2) = &HB8
UTF8(3) = &HAD
UTF8(4) = &HE5
UTF8(5) = &H9B
UTF8(6) = &HBD
UTF8(7) = &H2C
UTF8(8) = &H62
UTF8(9) = &H63
Dim bufSize As Long
bufSize = MultiByteToWideChar(65001, 0&, UTF8(0), 10, 0, 0)
Dim str As String
str = Space(bufSize)
MultiByteToWideChar 65001, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(str), bufSize
End Sub
b = StrConv(s, vbFromUnicode)
s读取进来的时候其实就已经决定了是ANSI的了...
没法子,VB6是ANSI的.
--------------------编程问答-------------------- 有是vb6惹的祸 --------------------编程问答-------------------- string 类型对单个存在的ascii值在128~254的字符支持有问题 --------------------编程问答-------------------- 既然是 UTF8 编码，就不能用 StrConv 进行 Unicode-DBSC 转换。
Public Function UTF8_Decode(ByVal s As String) As String--------------------编程问答-------------------- 楼主似乎没搞清楚，UTF8，UTF16等，都是UNICODE的不同的表现形式 --------------------编程问答-------------------- 不要用String，改用Byte() --------------------编程问答--------------------
...
b = s ' StrConv(s, vbFromUnicode)
...
End Function
Public Function UTF8_Encode(ByVal strUnicode As String) As String
...
UTF8_Encode = b ' StrConv(b, vbUnicode)
...
End Function
Option Explicit--------------------编程问答-------------------- 楼上的代码不错 --------------------编程问答-------------------- 看不懂啊 --------------------编程问答-------------------- 进来学习一下 --------------------编程问答-------------------- jf.. --------------------编程问答-------------------- 哇~~~看不懂呀 --------------------编程问答-------------------- lhcwjy大大 能不能帮写一个GB2312转UTF的代码撒 vb6里面的 --------------------编程问答-------------------- 看不懂啊 --------------------编程问答-------------------- 额 有那么点、、、、、 --------------------编程问答--------------------
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Function UTF8ToUTF16(UTF8() As Byte) As String
Dim bufSize As Long
bufSize = MultiByteToWideChar(65001, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0)
UTF8ToUTF16 = Space(bufSize)
MultiByteToWideChar 65001, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(UTF8ToUTF16), bufSize
End Function
Function UTF16ToUTF8(UTF16 As String) As Byte()
Dim bufSize As Long
Dim arr() As Byte
bufSize = WideCharToMultiByte(65001, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0)
ReDim arr(bufSize - 1)
WideCharToMultiByte 65001, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0
UTF16ToUTF8 = arr
End Function
Private Sub Command1_Click()
Dim str As String
str = UTF8ToUTF16(UTF16ToUTF8("ab中,c"))
End Sub
按照我7楼的说明，改动你代码中的两行代码就正确了。 --------------------编程问答-------------------- ding le --------------------编程问答--------------------
顶 --------------------编程问答-------------------- 搞不来
--------------------编程问答-------------------- 帮顶吧 --------------------编程问答-------------------- sdfsdfsdf --------------------编程问答-------------------- 我顶我顶我顶！！！！！！！！！！！！！！！！！！！1
--------------------编程问答-------------------- 很好，很需要，谢了 --------------------编程问答-------------------- xiexiele --------------------编程问答-------------------- dkdkdkdkkdkdkdkd --------------------编程问答-------------------- 帮楼主顶。 --------------------编程问答-------------------- 把上面的代码再次修改了一下，利用这两个函数，可以实现各种编码之间的转换:
Option Explicit--------------------编程问答--------------------
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
'常用的代码页：UTF-8:65001；GB2312:936；GB18030：54936；UTF-7：65000
Function MultiByteToUTF16(UTF8() As Byte, CodePage As Long) As String
Dim bufSize As Long
bufSize = MultiByteToWideChar(CodePage, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0)
MultiByteToUTF16 = Space(bufSize)
MultiByteToWideChar CodePage, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(MultiByteToUTF16), bufSize
End Function
Function UTF16ToMultiByte(UTF16 As String, CodePage As Long) As Byte()
Dim bufSize As Long
Dim arr() As Byte
bufSize = WideCharToMultiByte(CodePage, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0)
ReDim arr(bufSize - 1)
WideCharToMultiByte CodePage, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0
UTF16ToMultiByte = arr
End Function
Private Sub Command1_Click()
Dim str As String
MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", 65001), 65001)
End Sub
每天回帖即可获得10分可用分！小技巧：教您如何更快获得可用分
这里发言，表示您接受了CSDN社区的用户行为准则。
请对您的言行负责，并遵守中华人民共和国有关法律法规,尊重网上道德。
转载文章请注明出自“CSDN（www.csdn.net）”。如是商业用途请联系原作者。
--------------------编程问答-------------------- 看不懂了。。。。顶 --------------------编程问答-------------------- 不太看得懂啦，目前 --------------------编程问答-------------------- 同志们 还要继续吗 需要继续延伸下去吗 --------------------编程问答-------------------- 学习了,原来还可以这样转换啊! --------------------编程问答--------------------
强！ --------------------编程问答-------------------- 呵呵！强啊 --------------------编程问答-------------------- 迷糊~~ --------------------编程问答--------------------
Private Function Utf8ToUnicode(ByRef Utf() As Byte) As String--------------------编程问答-------------------- vb好难看呀 --------------------编程问答-------------------- 厉害，太酷了，VB... --------------------编程问答-------------------- 每天回贴，可得十分 --------------------编程问答-------------------- '----------------------------------------------------
Dim utfLen As Long
utfLen = -1
On Error Resume Next
utfLen = UBound(Utf)
If utfLen = -1 Then Exit Function
On Error GoTo 0
Dim i As Long, j As Long, k As Long, N As Long
Dim b As Byte, cnt As Byte
Dim Buf() As String
ReDim Buf(utfLen)
i = 0
j = 0
Do While i <= utfLen
b = Utf(i)
If (b And &HFC) = &HFC Then
cnt = 6
ElseIf (b And &HF8) = &HF8 Then
cnt = 5
ElseIf (b And &HF0) = &HF0 Then
cnt = 4
ElseIf (b And &HE0) = &HE0 Then
cnt = 3
ElseIf (b And &HC0) = &HC0 Then
cnt = 2
Else
cnt = 1
End If
If i + cnt - 1 > utfLen Then
Buf(j) = "?"
Exit Do
End If
Select Case cnt
Case 2
N = b And &H1F
Case 3
N = b And &HF
Case 4
N = b And &H7
Case 5
N = b And &H3
Case 6
N = b And &H1
Case Else
Buf(j) = Chr(b)
GoTo Continued:
End Select
For k = 1 To cnt - 1
b = Utf(i + k)
N = N * &H40 + (b And &H3F)
Next
Buf(j) = ChrW(N)
Continued:
i = i + cnt
j = j + 1
Loop
Utf8ToUnicode = Join(Buf, "")
End Function
' 函数名称：UTF8Encode
' 函数功能：将UNICODE字符串转换为UTF-8编码
' 参数说明：strSource需要进行编码的字符串
' 返 回 值：转换为UTF-8编码后的字节数组
'----------------------------------------------------
Public Function UTF8Encode(ByRef strSource As String) As Byte()
Dim bytTarget() As Byte '目标字符串字节数组
Dim lngSourceLen As Long '源字符串长度
Dim lngTargetLen As Long '目标字符串字节数
lngSourceLen = Len(strSource) '获得源字符串的UNICODE编码长度
If lngSourceLen = 0 Then Exit Function '如果数组为空(即源字符串为空)则退出
lngTargetLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strSource), lngSourceLen, ByVal 0, 0, vbNullString, 0) '获得目标字符串字节数
ReDim bytTarget(lngTargetLen - 1) '准备目标字符串缓冲区
WideCharToMultiByte CP_UTF8, 0, StrPtr(strSource), lngSourceLen, ByVal VarPtr(bytTarget(0)), lngTargetLen, vbNullString, 0 '转换源字符串为UTF8编码的目标字符串字节数组
UTF8Encode = bytTarget '返回结果
End Function
'----------------------------------------------------
' 函数名称：UTF8Decode
' 函数功能：将UTF-8编码的字节数组转换为UNICODE字符串
' 参数说明：bytSource需要进行解码的UTF-8字节数组
' 返 回 值：转换为UNICODE编码后的字符串
'----------------------------------------------------
Public Function UTF8Decode(ByRef bytSource() As Byte) As String
Dim i As Long, j As Long
Dim strTarget As String '目标字符串字
Dim lngSourceLen As Long '源字符串长度
Dim lngTargetLen As Long '目标字符串字节数
Dim lngAscW As Long, lngCharCount As Long
If SafeArrayGetDim(bytSource) = 0 Then Exit Function '如果源数组为空则退出
lngSourceLen = UBound(bytSource) + 1
For i = 0 To lngSourceLen - 1
'判断遇到的一组UTF8表示的字符串的首个字节，并依此得到后面连续的几个字节的个数
lngAscW = bytSource(i)
If (lngAscW And &HFC) = &HFC Then
lngCharCount = 6
lngAscW = lngAscW And &H1
ElseIf (lngAscW And &HF8) = &HF8 Then
lngCharCount = 5
lngAscW = lngAscW And &H3
ElseIf (lngAscW And &HF0) = &HF0 Then
lngCharCount = 4
lngAscW = lngAscW And &H7
ElseIf (lngAscW And &HE0) = &HE0 Then
lngCharCount = 3
lngAscW = lngAscW And &HF
ElseIf (lngAscW And &HC0) = &HC0 Then
lngCharCount = 2
lngAscW = lngAscW And &H1F
Else
lngCharCount = 1
strTarget = strTarget & ChrW(lngAscW)
End If
'如果该组字节数大小1，则取出该组的字节并转换
If lngCharCount > 1 Then
If i + lngCharCount - 1 > lngSourceLen Then Exit For
For j = 1 To lngCharCount - 1
lngAscW = lngAscW * &H40 + (bytSource(i + j) And &H3F)
Next
If lngAscW > -32768 And lngAscW < 65536 Then strTarget = strTarget & ChrW(lngAscW)
i = i + (lngCharCount - 1) '循环计数跳过lngCharCount-1个字节
End If
Next
UTF8Decode = strTarget
End Function --------------------编程问答-------------------- --------------------编程问答-------------------- --------------------编程问答-------------------- --------------------编程问答-------------------- 顶.................. --------------------编程问答-------------------- hai mei kao si ji de cai niao jin guo ! --------------------编程问答-------------------- 还是没有解决啊 --------------------编程问答-------------------- --------------------编程问答-------------------- 文本转换，经常要用到，看看。
补充：VB , 基础类
