欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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

程序员文章站 2022-03-25 21:38:27
复制代码 代码如下:'//转换中文为unicode function urlencoding(vstrin)     di...

复制代码 代码如下:

'//转换中文为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