直接保存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 +

上一个：叶子asp分页类
下一个：FSO一些代码