% '名稱：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
