'******************************************************************************** 'function(公有) '名称： 远程抓取函数 '作用： 利用xmlhttp远程抓取数据 '参数： smethod --- 发送方式 ' surl ------ 目标地址 ' imode ----- 返回内容类型：0为二进制，1为文本，2为cookie，3为文件头信息 ' sbase ----- 设定编码 ' sreferer -- 设定来源 ' scookie --- 设定cookie ' slanguage - 设定语言 ' sdata ----- 设定要发送的参数 ' scontent -- 设定接收数据类型 ' sagent ---- 设定浏览器 ' sencoding - 设定gzip压缩 ' saccept --- 设定文档类型 '******************************************************************************** public function senfe_stealdata(smethod, surl, imode, sbase, sreferer, scookie, slanguage, sdata, scontent, sagent, sencoding, saccept) dim oxmlhttp : set oxmlhttp = server.createobject("msxml2.serverxmlhttp") with oxmlhttp if smethod="" then smethod = "get" .open smethod, surl, false '设定页面来源 if sreferer<>"" then .setrequestheader "referer", sreferer else .setrequestheader "referer", split(surl, "/")(2) end if if scookie<>"" then .setrequestheader "cookie", scookie '设定cookie if slanguage<>"" then .setrequestheader "accept-language", slanguage '设定语言 if sdata<>"" then .setrequestheader "content-length", len(sdata) '设定数据长度 if scontent<>"" then .setrequestheader "content-type", scontent '设定接受数据类型 if sagent<>"" then .setrequestheader "user-agent", sagent '设定浏览器 if sencoding<>"" then .setrequestheader "accept-encoding", sencoding '设定gzip压缩 if saccept<>"" then .setrequestheader "accept", saccept '文档类型 .send sdata 'while .readystate <> 4 ' .waitforresponse 1000 'wend if .readystate<>4 or .status<>200 then senfe_stealdata = "无法取到数据！" exit function end if select case imode case 0 senfe_stealdata = .responsebody case 1 if sbase<>"" then senfe_stealdata = bytestobstr(.responsebody, sbase) else senfe_stealdata = .responsetext end if case 2 senfe_stealdata = .getresponseheader("set-cookie") case else senfe_stealdata = .getallresponseheaders() end select end with end function '******************************************************************************** '作用： 编码转换 '参数： sbody - 要转换的内容 ' scset - 编码 '******************************************************************************** function bytestobstr(sbody, scset) with oados .type = 1 .mode = 3 .open .write sbody .position = 0 .type = 2 .charset = scset bytestobstr = .readtext .close end with end function
