直接保存URL图像或网页到服务器本地的类

<% @ language="vbscript" codepage="936"%>
<%
option explicit

class boxinfoimg
    '传输类的使用方法
    '图象上传和上传信息获取class

    '用法:
    'dim imgup
    'set imgup=new boxinfoimg

    '属性: 
    'imgup.width    '宽
    'imgup.height    '高
    'imgup.imgsize    '大小
    'imgup.imgtype    '类型
    'imgup.imgname    '文件名
    'imgup.imgname '图像文件名:"&
    'imgup.filename '文件名"&
    'imgup.extname '扩展名"
    'imgup.diskpath '保存位置"
    'imgup.xupath '虚拟路径"
    'imgup.newurl '保存后url"
    'imgup.savemode '保存后url"

    '方法:
    'imgup.saveimg(fullpath)    '保存图像文件

    dim ados
    dim width,height,imgsize,imgtype,imgname,filename
    dim prename,extname
    dim savepath,savename,savemode
    dim diskpath,xupath,newurl
    dim textstr
    dim i

    private sub class_initialize
        set ados=server.createobject("adodb.stream")
            ados.type=1 
            ados.mode=3 
            ados.open 
            getimagesize
    end sub

    private sub class_terminate
        ados.close
        set ados=nothing
    end sub

    public function getimagesize() 

            dim ret(3),bflag,fdata,fsize

            fdata=getwebdata(getstrurl) '取得xmlhttp数据
            fsize=clng(lenb(fdata))        '取得数据尺寸

            
            if fsize=0 then 
                exit function 
                r_write "无有效数据保存",0
            end if

            ados.write fdata    
            ados.position=0

            savename=isavename
            savepath=isavepath
            savemode=isavemode

            '写文本对象读取图像长宽和类型

            ados.position=0 '重置数据开始位置 
            bflag=ados.read(3)

            if isnull(bflag) then 
                width=0
                height=0
                imgsize=0
                imgtype="unknow"
                ret(0)=imgtype:ret(1)=width:ret(2)=height:ret(3)=""
                getimagesize=ret
                exit function
            end if

            '取文件类型和长宽
            select case hex(binval(bflag))
            case "4e5089":
                ados.read(15)
                ret(0)="png"
                ret(1)=binval2(ados.read(2))
                ados.read(2)
                ret(2)=binval2(ados.read(2))
            case "464947":
                ados.read(3)
                ret(0)="gif"
                ret(1)=binval(ados.read(2))
                ret(2)=binval(ados.read(2))
            case "ffd8ff":
                dim p1
                do 
                do: p1=binval(ados.read(1)): loop while p1=255 and not ados.eos
                if p1>191 and p1<196 then exit do else ados.read(binval2(ados.read(2))-2)
                do:p1=binval(ados.read(1)):loop while p1<255 and not ados.eos
            loop while true
                ados.read(3)
                ret(0)="jpg"
                ret(2)=binval2(ados.read(2))
                ret(1)=binval2(ados.read(2))
            case else:
                if left(bin2str(bflag),2)="bm" then
                    ados.read(15)
                    ret(0)="bmp"
                    ret(1)=binval(ados.read(4))
                    ret(2)=binval(ados.read(4))
                else
                    ret(0)=""
                end if
            end select
            '
            dim tempstr
            dim namestr
            dim defaultname
            dim ln
            tempstr=split(getstrurl,"/")
            namestr=tempstr(ubound(tempstr))
            if namestr="" then
                r_write "错误的url,请输入可访问的url",0
                exit function
            end if
            filename=split(namestr,"?")(0)
            ln=instrrev(filename,".")
            if ln>0 then 
                prename=left(filename,instrrev(filename,".")-1)
            else
                prename=filename
            end if
            'r_write filename,1
            'r_write instrrev(filename,"."),1
            'r_write filename,0
            extname=right(filename,len(filename)-instrrev(filename,"."))

            select case ret(0)
            case "png","jpg","bmp","gif","swf"
                width=ret(1)
                height=ret(2)
                imgsize=fsize
                imgtype=ret(0)
                imgname=prename&"."&ret(0)
            case else
                width=0
                height=0
                imgsize=fsize
                imgname="unknow"
                imgtype=".unknow"
            end select

            if savemode="1" then
                defaultname=imgname
                if savename="" then 
                    savename=defaultname
                else
                    if lcase(right(savename,4))<>"."&imgtype then
                        savename=savename&"."&imgtype
                    end if
                end if
            else
                defaultname=filename
            end if
            if savename="" then savename=defaultname
            savepath=replace(savepath,"//","/")
            if right(savepath,1)<>"/" then savepath=savepath&"/"
            if savepath="" then savepath="./"
                diskpath=server.mappath(savepath&savename)
                xupath=replace(replace(diskpath,server.mappath("/"),""),"\","/")
            newurl="http://"&request.servervariables("server_name")&xupath

            getimagesize=ret
    end function

    public function saveimg(fullpath)
        saveimg=false
        if savemode="1" then
            if trim(fullpath)="" or _
                width=0 or _ 
                height=0 or _
                imgsize=0 or _
                imgtype=".unknow" then exit function end if
        end if
        ados.position=0
        if savemode="2" then
            ados.type=2
            ados.charset ="gb2312"
            ados.savetofile fullpath,2
            textstr=ados.readtext()
        else
            ados.savetofile fullpath,2
        end if
        saveimg=true
    end function

    private function bin2str(bin)
        dim i,str,clow
        for i=1 to lenb(bin)
            clow=midb(bin,i,1)
        if ascb(clow)<128 then
            str = str & chr(ascb(clow))
        else
            i=i+1
            if i <= lenb(bin) then str = str & chr(ascw(midb(bin,i,1)&clow))
        end if
        next 
            bin2str = str
    end function

    private function num2str(num,base,lens)
        dim ret:ret = ""
        while(num>=base)
            ret=(num mod base) & ret
            num=(num - num mod base)/base
        wend
            num2str = right(string(lens,"0") & num & ret,lens)
    end function

    private function str2num(str,base)
        dim ret:ret = 0
        for i=1 to len(str)
            ret = ret *base + cint(mid(str,i,1))
        next
            str2num=ret
    end function

    private function binval(bin)
        dim ret:ret = 0
        for i = lenb(bin) to 1 step -1
            ret = ret *256 + ascb(midb(bin,i,1))
        next
            binval=ret
    end function

    private function binval2(bin)
        dim ret:ret = 0
        for i = 1 to lenb(bin)
            ret = ret *256 + ascb(midb(bin,i,1))
        next
            binval2=ret
    end function

    private    function getwebdata(byval strurl)
        if strurl="" then 
            r_write "无效",1
            exit function
        end if
        dim tempstr
        tempstr=split(getstrurl,"/")
        if tempstr(ubound(tempstr))="" or instr(strurl,"/")=0 then
            r_write "未指定有效的url",0
            exit function
        end if
        dim retrieval
        set retrieval = server.createobject("microsoft.xmlhttp")
        with retrieval
        .open "get", strurl, false, "", ""
        .send
        getwebdata =.responsebody
        end with
        set retrieval = nothing
    end function            

end class
%>
<%
sub saveupload(geturl,savepath,savename,mode)
    dim chkinfo

    if geturl="" then 
        call tform()
        r_write "<br>传输文件栏没有填写!",0
    end if

    set imgup=new boxinfoimg

    if mode="1" and imgup.imgname="unknow" then
        call tform()
        set imgup=nothing
        r_write "<br>传输文件栏没有填写有效的图像url!",0
    end if

    chkinfo=""
    dim i,teststr,showstr
    '限定格式
    select case imgup.imgtype
    case "png","jpg","bmp","gif"
        if imgup.width=0 or imgup.height=0 or imgup.imgsize=0 then 
            chkinfo="<li>"+"传输图像数据不存在,请确定你的url是否正确"
        end if
    case else 
        chkinfo="<li>无效的传输格式,允许图像数据格式为 ""png"",""jpg"",""bmp"",""gif""</li>"
    end select

    'r_write savepath,1
    'r_write mode,1
    'r_write imgup.imgname,1
    'r_write imgup.filename,1
    'r_write "savename="&savename,1

    if mode="1" and chkinfo<>"" then '检查上传图像数据合格后,则保存之
            call tform()
            r_write chkinfo,0
    else
        server.scripttimeout=5000
        imgup.saveimg imgup.diskpath     
    end if
'-------------
            r_write "<b>===处理结果部分资料===</b><br>",1
            r_write "　　宽:"&imgup.width&" pix",1
            r_write "　　高:"&imgup.height&" pix",1
            r_write "　大小:"&formatnumber(imgup.imgsize/1024,2,-1)&" kb",1
            r_write "　格式:"&imgup.imgtype,1
            r_write "图像文件名:"&imgup.imgname,1
            r_write "文件名:"&imgup.filename,1
            r_write "扩展名:"&imgup.extname,1
            r_write "保存位置:"&imgup.diskpath,1
            r_write "虚拟路径:"&imgup.xupath,1
            r_write "保存后url:"&imgup.newurl,1
        call tform()
        set imgup=nothing 
            r_write "------------------------<br>传输完毕",0
end sub

sub tform()
%>
<form method=post name=form2 style="margin:0px;">
　获取 url：<input type="text" size=50 name="getstrurl" value="http://www.blueidea.com/img/common/logo.gif"><br>
　保存路径：<input type="text" size=50 name="savepath" value="./"><br>
保存文件名：<input type="text" size=50 name="savename" value=""><br>
　保存类型：
<input type="radio" name="savemode" value=1 <%if isavemode="1" or isavemode="" then response.write "checked" end if%>> web图像 
<input type="radio" name="savemode" value=2 <%if isavemode="2" then response.write "checked" end if%>> 文本文件
<input type="radio" name="savemode" value=0 <%if isavemode="0" then response.write "checked" end if%>> 二进制数据
   <input type="submit" value="确定提交">

<hr size=1>
<%
if getstrurl<>"" then
    if isavemode="2" then
        r_write "<button name=""previews"" title=""页面快照"" onclick=""runcode(0);"">run this code</button>",1
        r_write "<textarea cols=100 name=content rows=10 style="" width:90%;fixed;word-break:break-all;"">"&server.htmlencode(imgup.textstr)&"</textarea>",1
    else
         r_write "<img src="""&imgup.xupath&"?"&timer()&""" width="&imgup.width&" height="&imgup.height&" alt="&imgup.imgname&">",1
    end if
end if
%>
</form>
<hr size=1>
<br>如果保存为图像，不要加扩展名，自动识别加上，如果加的扩展名不合也回自动加上
<br>保存文件路径为空则保存在当前路径
<br>保存文件名为空则使用自动识别取得的文件名
<br>保存为其他任意方式，对asp html 等为取得发送结果的html
<%end sub

sub r_write(str,num)
    dim istr:istr=str
    dim inum:inum=num
    response.write str&"<br>"
    if inum=0 then response.end
end sub

'=================调用过程 execute========================
%>
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<head>
<title> new document </title>
<meta name="generator" content="editplus">
<meta name="author" content="v37">
<meta name="keywords" content="">
<meta name="description" content="">
<script language="javascript">
<!--
/*function runcode() 
{
var code=event.srcelement.parentelement.children[0].value;
var newwin=window.open('','',''); 
newwin.opener = null 
newwin.document.write(code);
newwin.document.close();
}
function setsmiley(what) 
{ 
document.postform.comment.value += " "+what; 
document.postform.comment.focus(); 
} */
    function runcode(num) //运行代码html
        {
         // var code=event.srcelement.parentelement.children[0].value;
         if(num==1){var code=window.form2.code.innertext;}
         if(num==0){var code=window.form2.content.innertext;}
         var newwin=window.open('','','');
         newwin.opener = null
         newwin.document.write(code);
         newwin.document.close();
        }
//-->
</script>
</head>
<body>
<%
dim imgup        '传输对象
dim getstrurl    '要获取的图像或网页url
dim isavename    '要保存的名字
dim isavepath    '要保存的虚拟路径
dim isavemode    '保存的模式 1 为图像 0 为任意文件
    isavepath=trim(request.form("savepath"))
    isavename=trim(request.form("savename"))
    getstrurl=trim(request.form("getstrurl"))
    isavemode=trim(request.form("savemode"))
if getstrurl<>"" then
    call saveupload(getstrurl,isavepath,isavename,isavemode)
    call tform()
else
    call tform()
end if
%>
</body>
</html>