RSS
热门关键字:  虚拟主机技术  vps团购  discuz架构  虚拟主机团购  curl
当前位置 :| 团购首页>网站编程>ASP>

asp保存远程图片和文件到本地

来源: 作者: 时间:2008-07-28 Tag:asp   点击:

<% @ 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    '文件名
mrans.com


    '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") mr ans
            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))        '取得数据尺寸
mrans

            
            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)="" mrans.com
                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) 字串6
                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 mrans
            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 字串6
            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  m r a n s
                    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) mrans.com
        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)) mrans.com
        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) 字串9
            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 mrans.com
            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
%>

 

 


    由于各种原因,我们无法获知[asp保存远程图片和文件到本地]原创作者,如侵犯了您的版权,请您及时联系我们!
最新评论共有 0 位网友发表了评论
发表评论
评论内容:不能超过250字,需审核,请自觉遵守互联网相关政策法规。
用户名: 密码:
匿名?
注册