当前位置 主页 > 服务器问题 > win服务器问题汇总 >

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

    栏目:win服务器问题汇总 时间:2019-10-14 15:09

    复制代码 代码如下:
    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