资源不存在" then huancun=gethttppage(wang,"","get","","","","*/*","no",1) wjrxie server.mappath(mulu&"/"&id&".txt"),"gb2312",trim(huancun(0)) response.write huancun(0) else response.write mmhuan end if else huancun=gethttppage(wang,"","get","","","","*/*","no",1) response.write huancun(0) end if 'response.write gethttppage("http://www.baidu.com/","","get","","","","*/*","no",1)(0) response.end %> <% '请求的网址，编码，提交方式post？get？，cookie,内容5，来路6,accept7,zijie8是否直接返回字节流yes或者no,tiao9是否抓取到转向页面0不抓，1抓 function gethttppage(url1,urlcode2,fangshi3,cookie4,neirong5,lailu6,accept7,zijie8,zhua9) dim http,neirong,wjrhuan(5) if len(url1)=0 then gethttppage=wjrhuan exit function end if '0 http.responseBody主体信息的解码 1头部信息getAllResponseHeaders() 2 状态码 3状态文本 4解码成utf-8的responseText ' set http=Server.createobject("MSXM"&"L2.XML"&"HTTP") ' set http=Server.createobject("Msx"&"ml2.Ser"&"verXML"&"HTTP") set http=Server.createobject("Win"&"Http.W"&"inHtt"&"pRe"&"quest"&".5.1") '采用WiHtt组件，支持模拟来路和https安全协议,比xmlttp好用，强 ' http://msdn.microsoft.com/en-us/library/aa384106.aspx ' http://msdn.microsoft.com/en-us/library/aa384068.aspx ' http://www.cppblog.com/kesalin/archive/2007/11/30/37567.aspx TimeInterval=20 '设定时间间隔 '如果下载时间很慢，就写成120秒 lResolve=10 '解析域名超时时间,秒 lConnect=10 '连接站点超时时间,秒 lSend=10 '发送数据请求超时时间,秒 lReceive=10 '下载数据超时时间,秒 '设置超时时间 http.setTimeouts lResolve*1000,lConnect*1000,lSend*1000,lReceive*1000 http.Option(4) = 13056 http.Option(6) = zhua9 '为True或者1时,当请求的页面中有跳转时,抓取跳转后的页面信息.false或者0相反不抓取 http.open ucase(fangshi3),url1,false ' http.setRequestHeader "Via","1.1 "&Request.ServerVariables("LOCAL_ADDR")&" (Mikrotik HttpProxy)" ' http.setRequestHeader "X-Forwarded-For",wjrgetip() ' http.setRequestHeader "X-Proxy-Id","1766125503" if ucase(fangshi3)="POST" then http.setRequestHeader "Content-Type","application/x-www-form-urlencoded" end if http.setRequestHeader "Accept",accept7 if len(lailu6)>0 then http.setRequestHeader "Referer",lailu6 end if '1008tebie http.setRequestHeader "User-Agent","Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0)" http.setRequestHeader "Accept-Language","zh-cn" http.setRequestHeader "Connection","Keep-Alive" http.setRequestHeader "Cache-Control","no-cache" ' http.setRequestHeader "Accept-Encoding","gzip, deflate" if len(cookie4)>0 then http.setRequestHeader "Cookie",cookie4 else ' http.setRequestHeader "Cookie","bbbb" end if 'response.write wjrsend&"dddddddddddddddddd" http.send(neirong5) wjrhuan(1)=http.getAllResponseHeaders() 'Response.write Replace(http.getAllResponseHeaders(),vbCrlf,"
" & vbCrlf) '全部头信息 wjrhuan(2)=http.status wjrhuan(3)=http.statustext wjrhuan(4)=http.responseText '暂时屏蔽，随需开关 '…………智能判断网页编码开始………… dim wenben,wenbeni,wenben3,bianmaok bianmaok="" wenben=lcase(http.getAllResponseHeaders()) '方案一：从头信息中获取，优先 两种情况，【1 不存在content-type头信息 http://www.jb51.net/404.htm】【2 存在，必须是text信息】 if instr(1,wenben,"content-type: ",1)=0 or instr(1,wenben,"content-type: text",1)>0 then '确定是文本内容 if instr(1,wenben,"content-type: ",1)>0 then wenbeni=tiress(wenben,"content-type: ",chr(13)&chr(10)) if instr(1,wenbeni,"charset=",1)>0 then bianmaok=tiress(wenbeni&chr(13)&chr(10),"charset=",chr(13)&chr(10)) end if end if 'bianmaok="" '方案二：从网页自身的代码中获取 if len(bianmaok)=0 then wenbeni=zzqu(http.responseText,"","=") if len(wenbeni)>0 then wenbeni=replace(wenbeni,"""","",1,-1,1) wenbeni=replace(wenbeni,"'","",1,-1,1) wenben3=zzqu(wenbeni,"charset=[a-z0-9\-\_]+","=") bianmaok=tiress(wenben3,"charset=","renyaai") end if end if '方案三：文件二进制头 很多文件无此特征符号 if len(bianmaok)=10 then If len(http.responseBody)>0 and AscB(MidB(http.responseBody,1,1))=&HEF and AscB(MidB(http.responseBody,2,1))=&HBB then bianmaok="utf-8" elseif len(http.responseBody)>10 and AscB(MidB(http.responseBody,1,1))=&HFF and AscB(MidB(http.responseBody,2,1))=&HFE then bianmaok="unicode" elseif len(http.responseBody)>10 and AscB(MidB(http.responseBody,1,1))=&HFE and AscB(MidB(http.responseBody,2,1))=&HFF then bianmaok="unicodeFFFE" else bianmaok="gb2312" '默认 end if end if end if 'response.write bianmaok '…………智能判断网页编码完毕………… if len(bianmaok)=0 then bianmaok="gb2312" end if if http.status=200 then if zijie8="yes" then wjrhuan(0)=http.responseBody '字节内容 else if instr(1,wenben,"content-encoding: gzip",1)=0 then 'gzip压缩的无法解码 if len(urlcode2)>0 then '人工设置编码 wjrhuan(0)=readfile(http.responseBody,urlcode2) '网页内容 else '智能解码 wjrhuan(0)=readfile(http.responseBody,bianmaok) '网页内容 end if else wjrhuan(0)="" end if end if end if gethttppage=wjrhuan set http=nothing if err.number<>0 then err.Clear end if end function '将字节流还原为字符 字节流、编码 function readfile(url1,urlcode2) if len(url1)=0 then '当内容长度为0，也就是没有内容的时候，直接输入空字符。否则后面的代码运行，会出错 20110109 readfile="" exit function end if dim srmobj set srmobj=Server.CreateObject("ado" & "db.stre" & "am") srmobj.type=1 srmobj.mode=3 srmobj.open srmobj.write url1 srmobj.position=0 srmobj.type=2 srmobj.charset=urlcode2 readfile=srmobj.readtext() set srmobj=nothing end function '正则表达式提取数据的函数,moshi代表模式，zifu代表要从中抽取内容的字符串,buyao代表含有这个字符的内容要。 function zzqu(zifu,moshi,buyao) dim zzexp,zzmat,zzmates set zzexp=new regexp zzexp.ignorecase=true zzexp.global=true zzexp.pattern=moshi '设置模式 set zzmates=zzexp.execute(zifu) for each zzmat in zzmates if instr(1,zzmat.value,buyao,1)>0 then zzqu=zzqu&zzmat.value&"renyaai" 'zzqu=zzmat.value&chr(13)&chr(10)&zzqu else end if '内容用字符间隔renyaai next set zzexp=nothing end function function riwen(mm) riwen=replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(mm,"ゴ",""),"ガ",""),"ギ",""),"グ",""),"ゲ",""),"ザ",""),"ジ",""),"ズ",""),"ヅ",""),"デ",""),"ド",""),"ポ",""),"ベ",""),"プ",""),"ビ",""),"パ",""),"ヴ",""),"ボ",""),"ペ",""),"ブ",""),"ピ",""),"バ",""),"ヂ",""),"ダ",""),"ゾ",""),"ゼ","") end function '下面是提取中间内容的函数: function tiress(trea,treb,trec) dim tia,tib,tic if instr(1,trea,treb,1)<1 then tiress="" exit function end if if instr(1,trea,trec,1)<1 then tiress="" exit function end if tia=instr(1,trea,treb,1) 'treb所处位置. tib=instr(tia+len(treb),trea,trec,1) 'treb后trec的位置。 if tib<1 then tiress="" exit function end if tiress=mid(trea,tia+len(treb),tib-tia-len(treb)) end function '读取文件的函数，dizhi为文件的地址，code为文件的编码 '例子response.write wjrdu(server.mappath("说明.txt"),"gb2312") function wjrdu(dizhi,code) dim stm,fso set fso=createobject("scripting.filesystemobject") if fso.fileexists(dizhi)=false then wjrdu="

资源不存在" set fso=nothing exit function end if set fso=nothing ' set stm=Server.CreateObject("ado" & "db.stre" & "am") set stm=Server.CreateObject("ado" & "db.stre" & "am") stm.Type=2 '以本模式读取 stm.mode=3 stm.charset=code stm.open stm.loadfromfile dizhi wjrdu=stm.readtext stm.Close end function '新增文件的函数，dizhi为新增文件的地址，code为文件的编码,neirong为添加的内容 '例子wjrxie server.mappath("5555mm.txt"),"gb2312","王建然" function wjrxie(dizhi,code,neirong) dim objStream 'Set objStream=Server.CreateObject("ado" & "db.stre" & "am") Set objStream=Server.CreateObject("ado" & "db.stre" & "am") With objStream .type=2 .mode=3 .Open .Charset = code .Position = objStream.Size .WriteText=neirong .SaveToFile dizhi,2 .Close End With Set objStream = Nothing end function function jibenurl() '网页所在目录，在此基础上构造其他返回地址 if Request.ServerVariables("SERVER_Port")=80 then jibenurl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("PATH_INFO") else jibenurl="http://"&Request.ServerVariables("SERVER_NAME")&":"&Request.ServerVariables("SERVER_Port")&Request.ServerVariables("PATH_INFO") end if jibenurl=left(jibenurl,InstrRev(jibenurl,"/")) end function %>