复制代码 代码如下:

'//转换中文为unicode

functionURLEncoding(vstrIn)

dimi

dimstrReturn,ThisChr,innerCode,Hight8,Low8

strReturn=""

fori=1toLen(vstrIn)

ThisChr=Mid(vStrIn,i,1)

IfAbs(Asc(ThisChr))<&HFFthen

strReturn=strReturn&ThisChr

else

innerCode=Asc(ThisChr)

IfinnerCode<0then

innerCode=innerCode+&H10000

endIf

Hight8=(innerCodeand&HFF00)&HFF

Low8=innerCodeand&HFF

strReturn=strReturn&"%"&Hex(Hight8)&"%"&Hex(Low8)

endIf

next

URLEncoding=strReturn

endfunction

'//转换unicode到正常文本

functionbytes2BSTR(vIn)

dimi

dimstrReturn,ThisCharCode,nextCharCode

strReturn=""

fori=1toLenB(vIn)

ThisCharCode=AscB(MidB(vIn,i,1))

IfThisCharCode<&H80then

strReturn=strReturn&Chr(ThisCharCode)

else

nextCharCode=AscB(MidB(vIn,i+1,1))

strReturn=strReturn&Chr(CLng(ThisCharCode)*&H100+CInt(nextCharCode))

i=i+1

endIf

next

bytes2BSTR=strReturn

endfunction

functiongetText(oReq,url)

onerrorresumenext

'//创建XMLHTTP对象

ifoReqisnothingthen

setoReq=CreateObject("MSXML2.XMLHTTP")

endif

ifnotoReqisnothingthen

oReq.open"get",url,false

oReq.send

ifoReq.status=200then

getText=bytes2BSTR(oReq.responseBody)

else

getText=""

endif

else

getText=""

endif

endfunction