深藍色論壇

代碼: 選擇全部

    Const vbFromUnicode = 128 
    Const vbUnicode = 64 
    Const adTypeBinary = 1 
    Const adTypeText = 2 
    Const adLongVarBinary = 205 
    Public Function StrConv(ByRef stringData, ByRef conversion) 
        Dim Stream 
        Set Stream = CreateObject("ADODB.Stream") 
     
        Const UnicodeCharaset = "Big5" 
        Const BinaryCharset = "X-ANSI" 
        Select Case conversion 
        Case vbFromUnicode 
            ' Converts a Unicode String To Ascii 
            With Stream 
                .Charset = UnicodeCharaset 
                .Type = adTypeText 
                .Open 
                .WriteText stringData 
                .Position = 0 
                .Charset = BinaryCharset 
                .Type = adTypeBinary 
                StrConv = MidB(.Read, 1) 
            End With 
             
        Case vbUnicode 
            ' Converts an Ascii String To Unicode 
            Dim Length 
            Dim Buffer 
             
            If TypeName(stringData) = "Null" Then 
                CStrU = "" 
                Exit Function 
            End If 
             
            stringData = MidB(stringData, 1) 
         
            Length = LenB(stringData) 
            Dim Rs 
            Set Rs = CreateObject("ADODB.Recordset") 
            Call Rs.Fields.Append("BinaryData", adLongVarBinary, Length) 
            Rs.Open 
            Rs.AddNew 
            Rs.Fields("BinaryData").AppendChunk (stringData & ChrB(0)) 
            Rs.Update 
            Buffer = Rs.Fields("BinaryData").GetChunk(Length) 
            Rs.Close 
            Set Rs = Nothing 
            With Stream 
                .Charset = BinaryCharset 
                .Type = adTypeBinary 
                .Open 
                Call .Write(Buffer) 
                .Position = 0 
                .Type = adTypeText 
                .Charset = UnicodeCharaset 
            End With 
             
            StrConv = Stream.ReadText(-1) 
        End Select 
        Stream.Close 
        Set Stream = Nothing 
    End Function 
     
     
    Example: 
    Data1 = "abc一二三456" 
    BArray = StrConv(Data1, vbFromUnicode) 
    Data2 = StrConv(MidB(BArray, 4, 6), vbUnicode)