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

相关推荐