7,785
社区成员




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
'常用的代码页:
const cpUTF8 =65001
const cpGB2312 = 936
const cpGB18030=54936
const cpUTF7 =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()
MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)
End Sub
授权给你,哈哈
'┏〓〓〓〓〓〓〓〓〓 SaveUnicodeFile,start 〓〓〓〓〓〓〓〓〓┓
'[简介]:
'以Unicode格式保存字符到文件
Function SaveUnicodeFile(FileName As String, Str As String) As Boolean
'VB源码,帮你写函数,帮你写代码,帮你写模块,帮你设计软件
'--需要什么函数或功能,可以联系我。
'版权所有,请保留作者信息.QQ:1085992075
'如需商业用途请联系作者
On Error GoTo Err
If Dir(FileName) <> "" Then Kill FileName
Dim ByteSz() As Byte
Dim hFile As Integer
ByteSz = Str
hFile = FreeFile
Open FileName For Binary As #hFile
Put #hFile, 1, &HFEFF 'unicode文件标记符
Put #hFile, , ByteSz ' ByteSz
Close #hFile
SaveUnicodeFile = True
Exit Function
Err:
End Function
'┗〓〓〓〓〓〓〓〓〓 SaveUnicodeFile,end 〓〓〓〓〓〓〓〓〓┛