richtextbox中能实现吗？
14 个解决方案
#1
可能有点问题
StrConv(yourstring,vbFromUnicode)
这个只能转换Unicode(UTF-32)
StrConv(yourstring,vbFromUnicode)
这个只能转换Unicode(UTF-32)
#2
你试试用WideCharToMutiByte这个API
#3
用FSO可以
#4
要先转换。
zyl910 的blog 上有处理 utf8 的模块。
http://blog.csdn.net/zyl910
zyl910 的blog 上有处理 utf8 的模块。
http://blog.csdn.net/zyl910
#5
前几天刚有人问过这个问题吧？看看这个代码能用吗?
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim s As String
s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode)
MsgBox s
s = DecodeToBytes(StrConv(s, vbFromUnicode))
MsgBox s
End Sub
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim s As String
s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode)
MsgBox s
s = DecodeToBytes(StrConv(s, vbFromUnicode))
MsgBox s
End Sub
#6
多谢各位
#7
以前搞过一次,看看行不行
Option Explicit
Public objStream As New ADODB.Stream
Public AlterStr As String
Public Sub UTF8ToANSI()
'先把UTF-8格式的文本读出来，放在AlterStr变量里面
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\" & TxtName
.Position = 0
.Charset = "UTF-8"
AlterStr = .ReadText
.Close
End With
'然后把AlterStr变量存入临时文本文件TempFile.txt中，格式默认为ANSI
Open "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\TempFile.txt" For Output As #1
Write #1, AlterStr
Close #1
End Sub
Option Explicit
Public objStream As New ADODB.Stream
Public AlterStr As String
Public Sub UTF8ToANSI()
'先把UTF-8格式的文本读出来，放在AlterStr变量里面
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\" & TxtName
.Position = 0
.Charset = "UTF-8"
AlterStr = .ReadText
.Close
End With
'然后把AlterStr变量存入临时文本文件TempFile.txt中，格式默认为ANSI
Open "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\TempFile.txt" For Output As #1
Write #1, AlterStr
Close #1
End Sub
#8
都不适合，我要讲一个utf-8文件中的内容，正确显示在richtext中
#9
utf-8文件是什么文件,文本文件???要显示在textbox中?
#10
能搞文本文件,别的没有试过.
Private Sub Form_Load()
Dim objStream As New ADODB.Stream
Dim str As String
With objStream
.Type = adTypeText
.Mode = 3
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\gaoliangchen\桌面\1.txt"
.Position = 0
.Charset = "UTF-8"
str = .ReadText
.Close
End With
Text1.Text = str
End Sub
Private Sub Form_Load()
Dim objStream As New ADODB.Stream
Dim str As String
With objStream
.Type = adTypeText
.Mode = 3
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\gaoliangchen\桌面\1.txt"
.Position = 0
.Charset = "UTF-8"
str = .ReadText
.Close
End With
Text1.Text = str
End Sub
#11
没转前:淇濆瓨姝ら〉锛屽嵆鍙湪鍏跺畠璁＄畻鏈轰笂浣跨敤
转换后:保存此页，即可在其它计算机上使用
转换后:保存此页，即可在其它计算机上使用
#12
从UTF-8格式的.txt中读出每一段内容，显示在richtextbox中，loadfile不行，不满足要求
#13
C:\1.txt内容如下
淇濆瓨姝ら〉锛屽嵆鍙湪鍏跺畠璁＄畻鏈轰笂浣跨敤
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim aData() As Byte
Dim sData As String
Dim nFileNumber As Integer
nFileNumber = FreeFile()
Open "C:\1.txt" For Binary As nFileNumber
ReDim aData(0 To LOF(nFileNumber) - 1) As Byte
Get nFileNumber, 1, aData
Close nFileNumber
sData = DecodeToBytes(aData)
Text1.Text = sData
'Text1.Text显示如下
'保存此页，即可在其它计算机上使用
'分段的话这样：Split(sData, vbCrlf)
End Sub
没什么问题呀？
淇濆瓨姝ら〉锛屽嵆鍙湪鍏跺畠璁＄畻鏈轰笂浣跨敤
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim aData() As Byte
Dim sData As String
Dim nFileNumber As Integer
nFileNumber = FreeFile()
Open "C:\1.txt" For Binary As nFileNumber
ReDim aData(0 To LOF(nFileNumber) - 1) As Byte
Get nFileNumber, 1, aData
Close nFileNumber
sData = DecodeToBytes(aData)
Text1.Text = sData
'Text1.Text显示如下
'保存此页，即可在其它计算机上使用
'分段的话这样：Split(sData, vbCrlf)
End Sub
没什么问题呀？
#14
Public Function UTF8ToString(ByRef aUTF8() As Byte) As String
'-----------------------------------------------
'Function Name: UTF8ToString
'Return Type: String
'Parameter List:
' - aUTF8() Byte:
'Describe:
'-----------------------------------------------
'Code By: Ouyang Feng
'DateTime: 2006-01-10
'Version: 1.00
'-----------------------------------------------
'Edit(1) -
' Code By:
' DateTime:
' Version:
'-----------------------------------------------
On Error GoTo REERR:
'* Note: Add code at here!
Dim strResult As String '用于存储文字结果
Dim aChar() As Byte '用于存储UCS-2的编码
Dim lpReadPoint As Long '用于分析UTF-8数组的指针变量
Dim strWORD As String '去掉UTF-8的Hex部分之后剩余的二进制字符串数据
Dim lngUCSByteCount As Long '存储UCS-2编码的数组长度
Dim lngUTFByteCount As Long '存储UTF-8编码的数组长度
Dim lpUTF8Point As Long '单个文字UTF8编码分析中使用的指针
Dim strTemp As String '每个字节的二进制编码
Dim intHexBegin As Integer 'Hex的开始位置
Dim lpUCSPoint As Long '填充UCS编码数据时所使用的指针
'获取UTF-8编码的字节长度，作为循环上限
lngUTFByteCount = UBound(aUTF8)
'将分析指针置0
lpReadPoint = 0
'循环解码，当分析指针到达并超过循环上界时退出
Do Until lpReadPoint > lngUTFByteCount
'获取下一个文字的UTF-8编码Hex数据
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
intHexBegin = InStr(1, strTemp, "0")
'如果第一位就是0，则表示这是一个与ACSII码相同的编码，否则，是一个2字节的编码
If intHexBegin = 1 Then
'在这种情况下，字符存储只占用了一个字节，直接获取
strResult = strResult & Chr(aUTF8(lpReadPoint))
'移动指针到下一个字节
MovePoint lpReadPoint
Else
'当开始位不为0时，表示这个编码使用了超过1个字节的长度来存储
'这个时候使用一个循环提取出所有属于当前文字的编码并采取反序
'重组的方式获得其Unicode编码
'首先获得UTF编码占据的字节空间长度，就是0开始的位置减去1，获得
'开始"1"的个数
lngUCSByteCount = intHexBegin - 1
'循环分析所有属于该文字编码的字节
For lpUTF8Point = 0 To lngUCSByteCount - 1
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
strWORD = strWORD & Right(strTemp, 8 - InStr(1, strTemp, "0"))
MovePoint lpReadPoint
Next
'将strWord的长度以0在之前填充为8的倍数
Do Until Len(strWORD) Mod 8 = 0
strWORD = "0" & strWORD
Loop
'获得文字UCS编码所占用的字节长度
lngUCSByteCount = Len(strWORD) / 8
'将lngUCSByteCount强制转换为2的倍数，因为最前面的8位肯定为“0”
If lngUCSByteCount = 3 Then lngUCSByteCount = 2
If lngUCSByteCount = 5 Then lngUCSByteCount = 4
'开辟文字UCS编码存储所占用的字节空间
ReDim aChar(lngUCSByteCount - 1)
'填充UCS编码数据
'反顺填充，strWord中的高位数据填充到aChar的低位
For lpUCSPoint = 0 To lngUCSByteCount - 1
aChar(lpUCSPoint) = ZH2to10(Mid(strWORD, (lngUCSByteCount - 1 - lpUCSPoint) * 8 + 1, 8), 0)
Next
'将文字数据追加到结果变量中
strResult = strResult & CStr(aChar)
'清空strWord数据，等待下一次循环
strWORD = ""
End If
Loop
'*Note:The function's Return value,must edit it!
UTF8ToString = strResult '/must be edit!
PORC_EXIT:
'*Note: Add exit code at here! Distory all parameters at here!
Exit Function
REERR:
'*Note:The function's Return value When an error,must edit it!
UTF8ToString = "" '/must be edit!
' Call BugAssert(C_ERROR_UNICODE_UTF8TOUCS2, C_ERROR_UNICODE_UTF8TOUCS2DE, "cls_UTF8.UTF8ToString()")
End Function
'ZH2to10()函数将二进制字符传转换成10进制
'ZH10to2()函数将10进制转换成二进制字符串
'MovePoint()对指定数值进行累加
'-----------------------------------------------
'Function Name: UTF8ToString
'Return Type: String
'Parameter List:
' - aUTF8() Byte:
'Describe:
'-----------------------------------------------
'Code By: Ouyang Feng
'DateTime: 2006-01-10
'Version: 1.00
'-----------------------------------------------
'Edit(1) -
' Code By:
' DateTime:
' Version:
'-----------------------------------------------
On Error GoTo REERR:
'* Note: Add code at here!
Dim strResult As String '用于存储文字结果
Dim aChar() As Byte '用于存储UCS-2的编码
Dim lpReadPoint As Long '用于分析UTF-8数组的指针变量
Dim strWORD As String '去掉UTF-8的Hex部分之后剩余的二进制字符串数据
Dim lngUCSByteCount As Long '存储UCS-2编码的数组长度
Dim lngUTFByteCount As Long '存储UTF-8编码的数组长度
Dim lpUTF8Point As Long '单个文字UTF8编码分析中使用的指针
Dim strTemp As String '每个字节的二进制编码
Dim intHexBegin As Integer 'Hex的开始位置
Dim lpUCSPoint As Long '填充UCS编码数据时所使用的指针
'获取UTF-8编码的字节长度，作为循环上限
lngUTFByteCount = UBound(aUTF8)
'将分析指针置0
lpReadPoint = 0
'循环解码，当分析指针到达并超过循环上界时退出
Do Until lpReadPoint > lngUTFByteCount
'获取下一个文字的UTF-8编码Hex数据
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
intHexBegin = InStr(1, strTemp, "0")
'如果第一位就是0，则表示这是一个与ACSII码相同的编码，否则，是一个2字节的编码
If intHexBegin = 1 Then
'在这种情况下，字符存储只占用了一个字节，直接获取
strResult = strResult & Chr(aUTF8(lpReadPoint))
'移动指针到下一个字节
MovePoint lpReadPoint
Else
'当开始位不为0时，表示这个编码使用了超过1个字节的长度来存储
'这个时候使用一个循环提取出所有属于当前文字的编码并采取反序
'重组的方式获得其Unicode编码
'首先获得UTF编码占据的字节空间长度，就是0开始的位置减去1，获得
'开始"1"的个数
lngUCSByteCount = intHexBegin - 1
'循环分析所有属于该文字编码的字节
For lpUTF8Point = 0 To lngUCSByteCount - 1
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
strWORD = strWORD & Right(strTemp, 8 - InStr(1, strTemp, "0"))
MovePoint lpReadPoint
Next
'将strWord的长度以0在之前填充为8的倍数
Do Until Len(strWORD) Mod 8 = 0
strWORD = "0" & strWORD
Loop
'获得文字UCS编码所占用的字节长度
lngUCSByteCount = Len(strWORD) / 8
'将lngUCSByteCount强制转换为2的倍数，因为最前面的8位肯定为“0”
If lngUCSByteCount = 3 Then lngUCSByteCount = 2
If lngUCSByteCount = 5 Then lngUCSByteCount = 4
'开辟文字UCS编码存储所占用的字节空间
ReDim aChar(lngUCSByteCount - 1)
'填充UCS编码数据
'反顺填充，strWord中的高位数据填充到aChar的低位
For lpUCSPoint = 0 To lngUCSByteCount - 1
aChar(lpUCSPoint) = ZH2to10(Mid(strWORD, (lngUCSByteCount - 1 - lpUCSPoint) * 8 + 1, 8), 0)
Next
'将文字数据追加到结果变量中
strResult = strResult & CStr(aChar)
'清空strWord数据，等待下一次循环
strWORD = ""
End If
Loop
'*Note:The function's Return value,must edit it!
UTF8ToString = strResult '/must be edit!
PORC_EXIT:
'*Note: Add exit code at here! Distory all parameters at here!
Exit Function
REERR:
'*Note:The function's Return value When an error,must edit it!
UTF8ToString = "" '/must be edit!
' Call BugAssert(C_ERROR_UNICODE_UTF8TOUCS2, C_ERROR_UNICODE_UTF8TOUCS2DE, "cls_UTF8.UTF8ToString()")
End Function
'ZH2to10()函数将二进制字符传转换成10进制
'ZH10to2()函数将10进制转换成二进制字符串
'MovePoint()对指定数值进行累加
#1
可能有点问题
StrConv(yourstring,vbFromUnicode)
这个只能转换Unicode(UTF-32)
StrConv(yourstring,vbFromUnicode)
这个只能转换Unicode(UTF-32)
#2
你试试用WideCharToMutiByte这个API
#3
用FSO可以
#4
要先转换。
zyl910 的blog 上有处理 utf8 的模块。
http://blog.csdn.net/zyl910
zyl910 的blog 上有处理 utf8 的模块。
http://blog.csdn.net/zyl910
#5
前几天刚有人问过这个问题吧？看看这个代码能用吗?
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim s As String
s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode)
MsgBox s
s = DecodeToBytes(StrConv(s, vbFromUnicode))
MsgBox s
End Sub
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim s As String
s = StrConv(EncodeToBytes("aa中文aa"), vbUnicode)
MsgBox s
s = DecodeToBytes(StrConv(s, vbFromUnicode))
MsgBox s
End Sub
#6
多谢各位
#7
以前搞过一次,看看行不行
Option Explicit
Public objStream As New ADODB.Stream
Public AlterStr As String
Public Sub UTF8ToANSI()
'先把UTF-8格式的文本读出来，放在AlterStr变量里面
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\" & TxtName
.Position = 0
.Charset = "UTF-8"
AlterStr = .ReadText
.Close
End With
'然后把AlterStr变量存入临时文本文件TempFile.txt中，格式默认为ANSI
Open "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\TempFile.txt" For Output As #1
Write #1, AlterStr
Close #1
End Sub
Option Explicit
Public objStream As New ADODB.Stream
Public AlterStr As String
Public Sub UTF8ToANSI()
'先把UTF-8格式的文本读出来，放在AlterStr变量里面
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\" & TxtName
.Position = 0
.Charset = "UTF-8"
AlterStr = .ReadText
.Close
End With
'然后把AlterStr变量存入临时文本文件TempFile.txt中，格式默认为ANSI
Open "C:\Documents and Settings\TOKIMEKI\桌面\WTSBF20051113035433\TempFile.txt" For Output As #1
Write #1, AlterStr
Close #1
End Sub
#8
都不适合，我要讲一个utf-8文件中的内容，正确显示在richtext中
#9
utf-8文件是什么文件,文本文件???要显示在textbox中?
#10
能搞文本文件,别的没有试过.
Private Sub Form_Load()
Dim objStream As New ADODB.Stream
Dim str As String
With objStream
.Type = adTypeText
.Mode = 3
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\gaoliangchen\桌面\1.txt"
.Position = 0
.Charset = "UTF-8"
str = .ReadText
.Close
End With
Text1.Text = str
End Sub
Private Sub Form_Load()
Dim objStream As New ADODB.Stream
Dim str As String
With objStream
.Type = adTypeText
.Mode = 3
.Mode = 3
.Open
.LoadFromFile "C:\Documents and Settings\gaoliangchen\桌面\1.txt"
.Position = 0
.Charset = "UTF-8"
str = .ReadText
.Close
End With
Text1.Text = str
End Sub
#11
没转前:淇濆瓨姝ら〉锛屽嵆鍙湪鍏跺畠璁＄畻鏈轰笂浣跨敤
转换后:保存此页，即可在其它计算机上使用
转换后:保存此页，即可在其它计算机上使用
#12
从UTF-8格式的.txt中读出每一段内容，显示在richtextbox中，loadfile不行，不满足要求
#13
C:\1.txt内容如下
淇濆瓨姝ら〉锛屽嵆鍙湪鍏跺畠璁＄畻鏈轰笂浣跨敤
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim aData() As Byte
Dim sData As String
Dim nFileNumber As Integer
nFileNumber = FreeFile()
Open "C:\1.txt" For Binary As nFileNumber
ReDim aData(0 To LOF(nFileNumber) - 1) As Byte
Get nFileNumber, 1, aData
Close nFileNumber
sData = DecodeToBytes(aData)
Text1.Text = sData
'Text1.Text显示如下
'保存此页，即可在其它计算机上使用
'分段的话这样：Split(sData, vbCrlf)
End Sub
没什么问题呀？
淇濆瓨姝ら〉锛屽嵆鍙湪鍏跺畠璁＄畻鏈轰笂浣跨敤
Option Explicit
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
End Function
Private Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
ReDim aRetn(0 To 2 * nSize - 1) As Byte
MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
DecodeToBytes = aRetn
End Function
Private Sub Command1_Click()
Dim aData() As Byte
Dim sData As String
Dim nFileNumber As Integer
nFileNumber = FreeFile()
Open "C:\1.txt" For Binary As nFileNumber
ReDim aData(0 To LOF(nFileNumber) - 1) As Byte
Get nFileNumber, 1, aData
Close nFileNumber
sData = DecodeToBytes(aData)
Text1.Text = sData
'Text1.Text显示如下
'保存此页，即可在其它计算机上使用
'分段的话这样：Split(sData, vbCrlf)
End Sub
没什么问题呀？
#14
Public Function UTF8ToString(ByRef aUTF8() As Byte) As String
'-----------------------------------------------
'Function Name: UTF8ToString
'Return Type: String
'Parameter List:
' - aUTF8() Byte:
'Describe:
'-----------------------------------------------
'Code By: Ouyang Feng
'DateTime: 2006-01-10
'Version: 1.00
'-----------------------------------------------
'Edit(1) -
' Code By:
' DateTime:
' Version:
'-----------------------------------------------
On Error GoTo REERR:
'* Note: Add code at here!
Dim strResult As String '用于存储文字结果
Dim aChar() As Byte '用于存储UCS-2的编码
Dim lpReadPoint As Long '用于分析UTF-8数组的指针变量
Dim strWORD As String '去掉UTF-8的Hex部分之后剩余的二进制字符串数据
Dim lngUCSByteCount As Long '存储UCS-2编码的数组长度
Dim lngUTFByteCount As Long '存储UTF-8编码的数组长度
Dim lpUTF8Point As Long '单个文字UTF8编码分析中使用的指针
Dim strTemp As String '每个字节的二进制编码
Dim intHexBegin As Integer 'Hex的开始位置
Dim lpUCSPoint As Long '填充UCS编码数据时所使用的指针
'获取UTF-8编码的字节长度，作为循环上限
lngUTFByteCount = UBound(aUTF8)
'将分析指针置0
lpReadPoint = 0
'循环解码，当分析指针到达并超过循环上界时退出
Do Until lpReadPoint > lngUTFByteCount
'获取下一个文字的UTF-8编码Hex数据
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
intHexBegin = InStr(1, strTemp, "0")
'如果第一位就是0，则表示这是一个与ACSII码相同的编码，否则，是一个2字节的编码
If intHexBegin = 1 Then
'在这种情况下，字符存储只占用了一个字节，直接获取
strResult = strResult & Chr(aUTF8(lpReadPoint))
'移动指针到下一个字节
MovePoint lpReadPoint
Else
'当开始位不为0时，表示这个编码使用了超过1个字节的长度来存储
'这个时候使用一个循环提取出所有属于当前文字的编码并采取反序
'重组的方式获得其Unicode编码
'首先获得UTF编码占据的字节空间长度，就是0开始的位置减去1，获得
'开始"1"的个数
lngUCSByteCount = intHexBegin - 1
'循环分析所有属于该文字编码的字节
For lpUTF8Point = 0 To lngUCSByteCount - 1
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
strWORD = strWORD & Right(strTemp, 8 - InStr(1, strTemp, "0"))
MovePoint lpReadPoint
Next
'将strWord的长度以0在之前填充为8的倍数
Do Until Len(strWORD) Mod 8 = 0
strWORD = "0" & strWORD
Loop
'获得文字UCS编码所占用的字节长度
lngUCSByteCount = Len(strWORD) / 8
'将lngUCSByteCount强制转换为2的倍数，因为最前面的8位肯定为“0”
If lngUCSByteCount = 3 Then lngUCSByteCount = 2
If lngUCSByteCount = 5 Then lngUCSByteCount = 4
'开辟文字UCS编码存储所占用的字节空间
ReDim aChar(lngUCSByteCount - 1)
'填充UCS编码数据
'反顺填充，strWord中的高位数据填充到aChar的低位
For lpUCSPoint = 0 To lngUCSByteCount - 1
aChar(lpUCSPoint) = ZH2to10(Mid(strWORD, (lngUCSByteCount - 1 - lpUCSPoint) * 8 + 1, 8), 0)
Next
'将文字数据追加到结果变量中
strResult = strResult & CStr(aChar)
'清空strWord数据，等待下一次循环
strWORD = ""
End If
Loop
'*Note:The function's Return value,must edit it!
UTF8ToString = strResult '/must be edit!
PORC_EXIT:
'*Note: Add exit code at here! Distory all parameters at here!
Exit Function
REERR:
'*Note:The function's Return value When an error,must edit it!
UTF8ToString = "" '/must be edit!
' Call BugAssert(C_ERROR_UNICODE_UTF8TOUCS2, C_ERROR_UNICODE_UTF8TOUCS2DE, "cls_UTF8.UTF8ToString()")
End Function
'ZH2to10()函数将二进制字符传转换成10进制
'ZH10to2()函数将10进制转换成二进制字符串
'MovePoint()对指定数值进行累加
'-----------------------------------------------
'Function Name: UTF8ToString
'Return Type: String
'Parameter List:
' - aUTF8() Byte:
'Describe:
'-----------------------------------------------
'Code By: Ouyang Feng
'DateTime: 2006-01-10
'Version: 1.00
'-----------------------------------------------
'Edit(1) -
' Code By:
' DateTime:
' Version:
'-----------------------------------------------
On Error GoTo REERR:
'* Note: Add code at here!
Dim strResult As String '用于存储文字结果
Dim aChar() As Byte '用于存储UCS-2的编码
Dim lpReadPoint As Long '用于分析UTF-8数组的指针变量
Dim strWORD As String '去掉UTF-8的Hex部分之后剩余的二进制字符串数据
Dim lngUCSByteCount As Long '存储UCS-2编码的数组长度
Dim lngUTFByteCount As Long '存储UTF-8编码的数组长度
Dim lpUTF8Point As Long '单个文字UTF8编码分析中使用的指针
Dim strTemp As String '每个字节的二进制编码
Dim intHexBegin As Integer 'Hex的开始位置
Dim lpUCSPoint As Long '填充UCS编码数据时所使用的指针
'获取UTF-8编码的字节长度，作为循环上限
lngUTFByteCount = UBound(aUTF8)
'将分析指针置0
lpReadPoint = 0
'循环解码，当分析指针到达并超过循环上界时退出
Do Until lpReadPoint > lngUTFByteCount
'获取下一个文字的UTF-8编码Hex数据
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
intHexBegin = InStr(1, strTemp, "0")
'如果第一位就是0，则表示这是一个与ACSII码相同的编码，否则，是一个2字节的编码
If intHexBegin = 1 Then
'在这种情况下，字符存储只占用了一个字节，直接获取
strResult = strResult & Chr(aUTF8(lpReadPoint))
'移动指针到下一个字节
MovePoint lpReadPoint
Else
'当开始位不为0时，表示这个编码使用了超过1个字节的长度来存储
'这个时候使用一个循环提取出所有属于当前文字的编码并采取反序
'重组的方式获得其Unicode编码
'首先获得UTF编码占据的字节空间长度，就是0开始的位置减去1，获得
'开始"1"的个数
lngUCSByteCount = intHexBegin - 1
'循环分析所有属于该文字编码的字节
For lpUTF8Point = 0 To lngUCSByteCount - 1
strTemp = Format(ZH10to2(aUTF8(lpReadPoint)), C_EJZFORMAT_8)
strWORD = strWORD & Right(strTemp, 8 - InStr(1, strTemp, "0"))
MovePoint lpReadPoint
Next
'将strWord的长度以0在之前填充为8的倍数
Do Until Len(strWORD) Mod 8 = 0
strWORD = "0" & strWORD
Loop
'获得文字UCS编码所占用的字节长度
lngUCSByteCount = Len(strWORD) / 8
'将lngUCSByteCount强制转换为2的倍数，因为最前面的8位肯定为“0”
If lngUCSByteCount = 3 Then lngUCSByteCount = 2
If lngUCSByteCount = 5 Then lngUCSByteCount = 4
'开辟文字UCS编码存储所占用的字节空间
ReDim aChar(lngUCSByteCount - 1)
'填充UCS编码数据
'反顺填充，strWord中的高位数据填充到aChar的低位
For lpUCSPoint = 0 To lngUCSByteCount - 1
aChar(lpUCSPoint) = ZH2to10(Mid(strWORD, (lngUCSByteCount - 1 - lpUCSPoint) * 8 + 1, 8), 0)
Next
'将文字数据追加到结果变量中
strResult = strResult & CStr(aChar)
'清空strWord数据，等待下一次循环
strWORD = ""
End If
Loop
'*Note:The function's Return value,must edit it!
UTF8ToString = strResult '/must be edit!
PORC_EXIT:
'*Note: Add exit code at here! Distory all parameters at here!
Exit Function
REERR:
'*Note:The function's Return value When an error,must edit it!
UTF8ToString = "" '/must be edit!
' Call BugAssert(C_ERROR_UNICODE_UTF8TOUCS2, C_ERROR_UNICODE_UTF8TOUCS2DE, "cls_UTF8.UTF8ToString()")
End Function
'ZH2to10()函数将二进制字符传转换成10进制
'ZH10to2()函数将10进制转换成二进制字符串
'MovePoint()对指定数值进行累加