newasp中下载类

<%
'================================================
' 函数名：saveremotefile
' 作  用：保存远程文件到本地
' 参  数：strfilename ----保存文件的名称
'         strremoteurl ----远程文件url
' 返回值：布尔值 true/false
'================================================
function saveremotefile(byval strfilename, byval strremoteurl)
    dim ostream, retrieval, getremotedata

    saveremotefile = false
    on error resume next
    set retrieval = server.createobject("microsoft.xmlhttp")
    retrieval.open "get", strremoteurl, false, "", ""
    retrieval.send
    if retrieval.readystate <> 4 then exit function
    if retrieval.status > 300 then exit function
    getremotedata = retrieval.responsebody
    set retrieval = nothing

    if lenb(getremotedata) > 100 then
        set ostream = server.createobject("adodb.stream")
        ostream.type = 1
        ostream.mode = 3
        ostream.open
        ostream.write getremotedata
        ostream.savetofile server.mappath(strfilename), 2
        ostream.cancel
        ostream.close
        set ostream = nothing
    else
        exit function
    end if

    if err.number = 0 then
        saveremotefile = true
    else
        err.clear
    end if
end function
%>

<%
class download_cls
    private suploaddir
    private nallowsize
    private sallowext
    private soriginalfilename
    private ssavefilename
    private spathfilename

    public property get remotefilename()
        remotefilename = soriginalfilename
    end property

    public property get localfilename()
        localfilename = ssavefilename
    end property

    public property get localfilepath()
        localfilepath = spathfilename
    end property

    public property let remotedir(byval strdir)
        suploaddir = strdir
    end property

    public property let allowmaxsize(byval intsize)
        nallowsize = intsize
    end property

    public property let allowextname(byval strext)
        sallowext = strext
    end property

    private sub class_initialize()
        on error resume next
        script_object = "scripting.filesystemobject"
        suploaddir = "uploadfile/"
        nallowsize = 500
        sallowext = "gif|jpg|png|bmp"
    end sub

    public function changeremote(shtml)
        on error resume next
        dim s_content
        s_content = shtml
        on error resume next
        dim re, s, remotefileurl, savefilename, savefiletype
        set re = new regexp
        re.ignorecase = true
        re.global = true
        re.pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([a-za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\s*\/)((\s)+[.]{1}(" & sallowext & ")))"
        set s = re.execute(s_content)
        dim a_remoteurl(), n, i, brepeat
        n = 0
        ' 转入无重复数据
        for each remotefileurl in s
            if n = 0 then
                n = n + 1
                redim a_remoteurl(n)
                a_remoteurl(n) = remotefileurl
            else
                brepeat = false
                for i = 1 to ubound(a_remoteurl)
                    if ucase(remotefileurl) = ucase(a_remoteurl(i)) then
                        brepeat = true
                        exit for
                    end if
                next
                if brepeat = false then
                    n = n + 1
                    redim preserve a_remoteurl(n)
                    a_remoteurl(n) = remotefileurl
                end if
            end if
        next
        ' 开始替换操作
        dim nfilenum, scontentpath,strfilepath
        scontentpath = relativepath2rootpath(suploaddir)
        nfilenum = 0
        for i = 1 to n
            savefiletype = mid(a_remoteurl(i), instrrev(a_remoteurl(i), ".") + 1)
            savefilename = getrndfilename(savefiletype)
            strfilepath = suploaddir & savefilename
            if saveremotefile(strfilepath, a_remoteurl(i)) = true then
                nfilenum = nfilenum + 1
                if nfilenum > 0 then
                    soriginalfilename = soriginalfilename & "|"
                    ssavefilename = ssavefilename & "|"
                    spathfilename = spathfilename & "|"
                end if
                soriginalfilename = soriginalfilename & mid(a_remoteurl(i), instrrev(a_remoteurl(i), "/") + 1)
                ssavefilename = ssavefilename & savefilename
                spathfilename = spathfilename & scontentpath & savefilename
                s_content = replace(s_content, a_remoteurl(i), scontentpath & savefilename, 1, -1, 1)
            end if
        next

        changeremote = s_content
    end function

    public function relativepath2rootpath(url)
'这个主要是实现../转换为实际路径
        dim stempurl
        stempurl = url
        if left(stempurl, 1) = "/" then
            relativepath2rootpath = stempurl
            exit function
        end if

        dim swebeditorpath
        swebeditorpath = request.servervariables("script_name")
        swebeditorpath = left(swebeditorpath, instrrev(swebeditorpath, "/") - 1)
        do while left(stempurl, 3) = "../"
            stempurl = mid(stempurl, 4)
            swebeditorpath = left(swebeditorpath, instrrev(swebeditorpath, "/") - 1)
        loop
        relativepath2rootpath = swebeditorpath & "/" & stempurl
    end function

    public function getrndfilename(sext)
        dim srnd
        randomize
        srnd = int(900 * rnd) + 100
        getrndfilename = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & srnd & "." & sext
    end function
end class
%>