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