asp通用采集函数冗余版可以保存文件到本地
时间:2021-07-01 10:21:17
帮助过:29人阅读
<%
'名称: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.gxlsystem.com/img/logo.gif", NowDir & "baidulogo.gif")
Call Save2Local("http://flash.jninfo.net/images/banner.swf", NowDir & "banner.swf")
Call Save2Local("//www.gxlsystem.com.com/", NowDir & "jb51.htmll")
response.Write getHTTPPage("//www.gxlsystem.com/")
%>