欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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

程序员文章站 2022-07-02 08:28:32
复制代码 代码如下:<% @ language="vbscript" codepage="936"%> <% option&...
复制代码 代码如下:

<% @ 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>