侧边栏壁纸
博主头像
落叶人生博主等级

走进秋风,寻找秋天的落叶

  • 累计撰写 130562 篇文章
  • 累计创建 28 个标签
  • 累计收到 9 条评论
标签搜索

目 录CONTENT

文章目录

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

2023-12-28 星期四 / 0 评论 / 0 点赞 / 74 阅读 / 4704 字

复制代码 代码如下:'//转换中文为unicode functionURLEncoding(vstrIn) dimi dimstrReturn,ThisChr,innerCode,Hight8,Low8 strRetur

复制代码 代码如下:

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

广告 广告

评论区