写ASP采集的一些函数

写ASP采集的一些函数

'=================================================='函数名：GetHttpPage'作 用：获取网页源码'参 数：HttpUrl ------网页地址'==================================================Function GetHttpPage(HttpUrl)If IsNull(HttpUrl)=True or Len(HttpUrl)<18 or HttpUrl="$False$" ThenGetHttpPage="$False$"Exit FunctionEnd IfDim HttpSet Http=server.createobject("MSXML2.XMLHTTP")Http.open "GET",HttpUrl,FalseHttp.Send()If Http.Readystate<>4 thenSet Http=Nothing GetHttpPage="$False$"Exit functionEnd ifGetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")Set Http=NothingIf Err.number<>0 thenErr.ClearEnd IfEnd Function'=================================================='函数名：BytesToBstr'作 用：将获取的源码转换为中文'参 数：Body ------要转换的变量'参 数：Cset ------要转换的类型'==================================================Function BytesToBstr(Body,Cset)Dim ObjstreamSet Objstream = Server.CreateObject("adodb.stream")objstream.Type = 1objstream.Mode =3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset = CsetBytesToBstr = objstream.ReadText objstream.Closeset objstream = nothingEnd Function'=================================================='函数名：PostHttpPage'作 用：登录'==================================================Function PostHttpPage(RefererUrl,PostUrl,PostData) Dim xmlHttp Dim RetStr Set xmlHttp = CreateObject("Msxml2.XMLHTTP") xmlHttp.Open "POST", PostUrl, FalseXmlHTTP.setRequestHeader "Content-Length",Len(PostData) xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"xmlHttp.setRequestHeader "Referer", RefererUrlxmlHttp.Send PostData If Err.Number <> 0 Then Set xmlHttp=NothingPostHttpPage = "$False$"Exit FunctionEnd IfPostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312")Set xmlHttp = nothingEnd Function '=================================================='函数名：UrlEncoding'作 用：转换编码'==================================================Function UrlEncoding(DataStr)Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8StrReturn = ""For Si = 1 To Len(DataStr)ThisChr = Mid(DataStr,Si,1)If Abs(Asc(ThisChr)) < &HFF ThenStrReturn = StrReturn & ThisChrElseInnerCode = Asc(ThisChr)If InnerCode < 0 ThenInnerCode = InnerCode + &H10000End IfHight8 = (InnerCode And &HFF00)\ &HFFLow8 = InnerCode And &HFFStrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)End IfNextUrlEncoding = StrReturnEnd Function'=================================================='函数名：GetBody'作 用：截取字符串'参 数：ConStr ------将要截取的字符串'参 数：StartStr ------开始字符串'参 数：OverStr ------结束字符串'参 数：IncluL ------是否包含StartStr'参 数：IncluR ------是否包含OverStr'==================================================Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)If C or C or IsNull(ConStr)=True or StartStr="" or IsNull(StartStr)=True or OverStr="" or IsNull(OverStr)=True ThenGetBody="$False$"Exit FunctionEnd IfDim ConStrTempDim Start,OverConStrTemp=Lcase(ConStr)StartStr=Lcase(StartStr)OverStr=Lcase(OverStr)Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)If Start<=0 thenGetBody="$False$"Exit FunctionElseIf IncluL=False ThenStart=Start+LenB(StartStr)End IfEnd IfOver=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)If Over<=0 or Over<=Start thenGetBody="$False$"Exit FunctionElseIf IncluR=True ThenOver=Over+LenB(OverStr)End IfEnd IfGetBody=MidB(ConStr,Start,Over-Start)End Function%>天气小偷范本<%On Error Resume NextServer.ScriptTimeOut=9999999Function getHTTPPage(Path)t = GetBody(Path)getHTTPPage=BytesToBstr(t,"GB2312")End functionFunction GetBody(url) on error resume nextSet Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBodyEnd With Set Retrieval = Nothing End FunctionFunction BytesToBstr(body,Cset)dim objstreamset objstream = Server.CreateObject("adodb.stream")objstream.Type = 1objstream.Mode =3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset = CsetBytesToBstr = objstream.ReadText objstream.Closeset objstream = nothingEnd FunctionFunction Newstring(wstr,strng)Newstring=Instr(lcase(wstr),lcase(strng))if Newstring<=0 then Newstring=Len(wstr)End Function%><%Dim wstr,str,url,start,over,citycity = Request.QueryString("id")url="http://appnews.qq.com/cgi-bin/news_qq_search?city="&city&""wstr=getHTTPPage(url)start=Newstring(wstr,"<html>")over=Newstring(wstr,"</HTML>")body=mid(wstr,start,over-start)body = replace(body,"skin1","天气预报 - 斯克网络")body = replace(body,"http://appnews.qq.com/cgi-bin/news_qq_search?city","tianqi.asp?id")response.write body%>