asp通用采集函数冗余版可以保存文件到本地

　　<%

　　'名称：asp通用采集函数冗余版，要精品版的有心人自己改

　　'作者：柳永法

　　'日期：2007-6-23

　　Function getHTTPPage(Path)

　　t = GetBody(Path)

　　getHTTPPage = BytesToBstr(t, "GB2312")

　　End Function

　　Function GetBody(url)

　　On Error Resume Next

　　Set xmlhttp = CreateObject("Microsoft.XMLHTTP")

　　With xmlhttp

　　.Open "Get", url, False, "", ""

　　.Send

　　.waitForResponse 1000

　　GetBody = .ResponseBody

　　End With

　　Set xmlhttp = Nothing

　　End Function

　　Function BytesToBstr(Body, Cset)

　　On Error Resume Next

　　Dim objstream

　　Set objstream = Server.CreateObject("adodb.stream")

　　objstream.Type = 1

　　objstream.Mode = 3

　　objstream.Open

　　objstream.Write Body

　　objstream.Position = 0

　　objstream.Type = 2

　　objstream.Charset = Cset

　　BytesToBstr = objstream.ReadText

　　objstream.Close

　　Set objstream = Nothing

　　End Function

　　Function getHTTPimg(url)

　　On Error Resume Next

　　Dim xmlhttp

　　Set xmlhttp = server.CreateObject("MSXML2.XMLHTTP")

　　xmlhttp.Open "GET", url, false

　　xmlhttp.send()

　　If xmlhttp.Status<>200 Then Exit Function

　　getHTTPimg = xmlhttp.responseBody

　　Set xmlhttp = Nothing

　　If Err.Number<>0 Then Err.Clear

　　End Function

　　Function Save2Local(from, tofile)

　　Dim geturl, objStream, imgs

　　geturl = Trim(from)

　　imgs = gethttpimg(geturl)

　　Set objStream = Server.CreateObject("ADODB.Stream")

　　objStream.Type = 1

　　objStream.Open

　　objstream.Write imgs

　　objstream.SaveToFile tofile, 2

　　objstream.Close()

　　Set objstream = Nothing

　　End Function

　　%>

　　<%

　　NowDir = server.mappath("/")

　　Call Save2Local("http://www.baidu.com/img/logo.gif", NowDir & "baidulogo.gif")

　　Call Save2Local("http://flash.jninfo.net/images/banner.swf", NowDir & "banner.swf")

　　Call Save2Local("http://www.glzy8.com.com/", NowDir & ".htmll")

　　response.Write getHTTPPage("http://www.glzy8.com/")

　　%>