技巧

热门文章

最新文章

联系方式

Access交流网

电  话：0760-88315075
热  线：0760-88315075

邮  编：528463
咨询QQ：1918333016
营销QQ：4008553990

Email：1918333016@qq.com

网  址：www.access-cn.com

VBA基础

Access如何将二进制UTF8转成字符串

分享一个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


发布人:tmtony-Access中国  
分享到：
点击次数：  更新时间：2013-07-22 14:42:42  【打印此页】  【关闭】
上一条：SQL中获取两日期之间的值  下一条：SQL Server中的IN与EXISTS的异同


相关文章

热门文章

热门产品