• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    直接保存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 p1196 then exit do else ADOS.read(binval2(ADOS.Read(2))-2)
                    do:p1=binVal(ADOS.Read(1)):loop while p1255 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(SavePathSaveName)
                    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%>> 二进制数据
    nbsp;nbsp;nbsp;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>
    上一篇:ASP 类专题
    下一篇:关于Script的Defer属性 原创
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

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