VBA基础
Access如何将二进制UTF8转成字符串
2013-07-22 14:42:42
分享一个utf-8转字符串的函数。解决编码带来的错误！
调用方法：
Private Sub cmdConvert_Click()
fm20TxtText.Text = FromUtf8(FromHex(fm20TxtHex.Text))
End Sub
函数如下：
Private Declare Function CryptStringToBinary Lib "Crypt32" _
Alias "CryptStringToBinaryW" ( _
ByVal pszString As Long, _
ByVal cchString As Long, _
ByVal dwFlags As Long, _
ByVal pbBinary As Long, _
ByRef pcbBinary As Long, _
ByRef pdwSkip As Long, _
ByRef pdwFlags As Long) As Long
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
Public Function FromHex(ByRef HexString As String) As Byte()
Const CRYPT_STRING_HEX As Long = &H4&
Dim lngOutLen As Long
Dim dwActualUsed As Long
Dim bytBinary() As Byte
If Len(HexString) < 1 Then Exit Function
'Determine output buffer length required.
If CryptStringToBinary(StrPtr(HexString), _
Len(HexString), _
CRYPT_STRING_HEX, _
0&, _
lngOutLen, _
ByVal 0&, _
dwActualUsed) = 0 Then
Err.Raise &H80044100, "FromHex", _
"CryptStringToBinary failed, error " & CStr(Err.LastDllError)
Else
'Convert to binary.
ReDim bytBinary(lngOutLen - 1)
If CryptStringToBinary(StrPtr(HexString), _
Len(HexString), _
CRYPT_STRING_HEX, _
VarPtr(bytBinary(0)), _
lngOutLen, _#p#分页标题#e#
ByVal 0&, _
dwActualUsed) = 0 Then
Err.Raise &H80044100, "FromHex", _
"CryptStringToBinary failed, error " & CStr(Err.LastDllError)
Else
FromHex = bytBinary
End If
End If
End Function
Public Function FromUtf8(ByRef Utf8() As Byte) As String
Const CP_UTF8 As Long = 65001
Dim lngBytes As Long
Dim lngResult As Long
On Error Resume Next
lngBytes = UBound(Utf8) - LBound(Utf8) + 1
If Err Then
Err.Clear
On Error GoTo 0
Err.Raise 5, "FromUtf8", "Invalid parameter: must be a dimensioned array"
End If
On Error GoTo 0
lngResult = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf8(LBound(Utf8))), _
lngBytes, 0, 0)
FromUtf8 = String$(lngResult, 0)
MultiByteToWideChar CP_UTF8, 0, VarPtr(Utf8(LBound(Utf8))), _
lngBytes, StrPtr(FromUtf8), lngResult
End Function