转换中文为unicode 转换unicode到正常文本

169 阅读 0 评论 112 点赞

我是靠谱客的博主苗条鸵鸟，最近开发中收集的这篇文章主要介绍转换中文为unicode 转换unicode到正常文本，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

复制代码代码如下:

'//转换中文为unicode 
function URLEncoding(vstrIn) 

    dim i 
    dim strReturn,ThisChr,innerCode,Hight8,Low8 

    strReturn = "" 
    for i = 1 to Len(vstrIn) 
        ThisChr = Mid(vStrIn,i,1) 
        If Abs(Asc(ThisChr)) < &HFF then 
            strReturn = strReturn & ThisChr 
        else 
            innerCode = Asc(ThisChr) 
            If innerCode < 0 then 
                innerCode = innerCode + &H10000 
            end If 
            Hight8 = (innerCode  and &HFF00)\ &HFF 
            Low8 = innerCode and &HFF 
            strReturn = strReturn & "%" & Hex(Hight8) &  "%" & Hex(Low8) 
        end If 
    next 

    URLEncoding = strReturn 

end function 

'//转换unicode到正常文本 
function bytes2BSTR(vIn) 
    dim i 
    dim strReturn,ThisCharCode,nextCharCode 

    strReturn = "" 
    for i = 1 to LenB(vIn) 
        ThisCharCode = AscB(MidB(vIn,i,1)) 
        If ThisCharCode < &H80 then 
            strReturn = strReturn & Chr(ThisCharCode) 
        else 
            nextCharCode = AscB(MidB(vIn,i+1,1)) 
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(nextCharCode)) 
            i = i + 1 
        end If 
    next 
    bytes2BSTR = strReturn 

end function 

function getText(oReq,url) 

    on error resume next 
    '//创建XMLHTTP对象     
    if oReq is nothing then 
        set oReq    = CreateObject("MSXML2.XMLHTTP") 
    end if 

    if    not oReq is nothing then 
        oReq.open "get",url,false 
        oReq.send  

        if oReq.status = 200 then 
            getText = bytes2BSTR(oReq.responseBody) 
        else 
            getText = "" 
        end if 
    else 
        getText = "" 
    end if 

end function