XMLHttp ASP远程获取网页内容代码

  

复制代码 代码如下:

  url="http://www.csdn.net/"

  wstr=getHTTPPage(url)

  start=Newstring(wstr,"资源精选<!-- 下载 -->")

  over=Newstring(wstr,"<div class=""friendlink"">")

  body=mid(wstr,200,500)

  response.write body

  Function getHTTPPage(url)

  dim objXML

  set objXML=createobject("MSXML2.XMLHTTP")'定义

  objXML.open "GET",url,false'打开

  objXML.send()'发送

  If objXML.readystate<>4 then '判断文档是否已经解析完,以做客户端接受返回消息

  exit function

  End If

  getHTTPPage=bBytesToBstr(objXML.responseBody)'返回信息,同时用函数定义编码

  set objXML=nothing'关闭

  if err.number<>0 then err.Clear

  End Function

  Function Newstring(wstr,strng)

  Newstring=Instr(lcase(wstr),lcase(strng))

  if Newstring<=0 then Newstring=Len(wstr)

  End Function

  Function bBytesToBstr(body)

  dim objstream

  set objstream = CreateObject("adodb.stream")

  objstream.Type = 1

  objstream.Mode =3

  objstream.Open

  objstream.Write body

  objstream.Position = 0

  objstream.Type = 2

  objstream.Charset = "gb2312"

  '转换原来默认的UTF-8编码转换成GB2312编码,否则直接用XMLHTTP调用有中文字符的网页得到的将是乱码

  bBytesToBstr = objstream.ReadText

  objstream.Close

  set objstream = nothing

  end Function

  Function BytesToBstr(body)

  dim objstream

  set objstream = CreateObject("adodb.stream")

  objstream.Type = 1

  objstream.Mode =3

  objstream.Open

  objstream.Write body

  objstream.Position = 0

  objstream.Type = 2

  objstream.Charset = "utf-8"

  '转换原来默认的UTF-8编码转换成GB2312编码,否则直接用XMLHTTP调用有中文字符的网页得到的将是乱码

  BytesToBstr = objstream.ReadText

  objstream.Close

  set objstream = nothing

  end Function