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

174 阅读 0 评论 115 点赞

我是靠谱客的博主跳跃抽屉，最近开发中收集的这篇文章主要介绍转换中文为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(o,url) 

    dim oReq 

    on error resume next 

    if o is nothing then 
        '//创建XMLHTTP对象 
        set oReq    = CreateObject("MSXML2.XMLHTTP") 
    else 
        set oReq    = o  
    end if 

        oReq.open "get",url,false 
        oReq.send  

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

end function