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

（编辑：银川站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!