用ASP VBS xmlhttp adodbstream下载和保存图片的代码

时间:2022-05-06 14:06:54

函数: 

复制代码代码如下:


function saveFile(data,recfilen)  
    set Astream=CreateObject("Adodb.Stream")'asp Server.CreateObject("Adodb.Stream")  
    fxt=mid(recfilen,InStrRev(recfilen,".")+1)  
    txt=false  
    if fxt="asp" or fxt="xml" or fxt="aspx" or fxt="php" or fxt="txt" or fxt="jsp" then  
        txt=true  
    end if  
    if txt then  
        Astream.type=2  '1 bin,2 txt  
    else  
        Astream.type=1  '1 bin,2 txt  
    end if  
    Astream.Mode = 3'     adModeRead =1   
                    '  adModeReadWrite =3   
                    '  adModeRecursive =4194304   
                    '  adModeShareDenyNone =16   
                    '  adModeShareDenyRead =4   
                    '  adModeShareDenyWrite =8   
                    '  adModeShareExclusive =12   
                    '  adModeUnknown =0   
                    '  adModeWrite =2   
    Astream.open  
    'Astream.CharSet = "GB2312"  
    'Astream.LoadFromFile(recfilen) '装载文件  
    'Assp=Astream.size  
    Astream.Position =0 '装载文件时设置为Assp  
    'Astream.Writetext tmpstr00,1  
    if txt then  
        data=bytes2bstr(data)  
        Astream.Writetext data,1  
    else  
        Astream.Write data  
    end if  

    Astream.SaveToFile recfilen,2  
    Astream.close      
end function  
    'Server.  

      
function downimg(url)  
    set oXMLHTTP =CreateObject("Microsoft.XMLHTTP")'asp Server.CreateObject("Microsoft.XMLHTTP")  
    data_got=""  
    oXMLHTTP.open "GET",url, false  
    oXMLHTTP.setRequestHeader "Accept-Encoding"," gzip, deflate"   
    oXMLHTTP.setRequestHeader "User-Agent","Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 2.0.50727)"   
    oXMLHTTP.send  
    rtstatus=oXMLHTTP.status  
    data_got=oXMLHTTP.responsebody  
    filename=mid(url,InStrRev(url,"/")+1)      
    if rtstatus=200 then  
        data_got=oXMLHTTP.responsebody  
        saveFile data_got,filename  
    else  
        data_got=""  
    end if  
    set oXMLHTTP =nothing  
end function  
function bytes2bstr(vin) '二进制转化为汉字  
    strreturn = ""   
    for i = 1 to lenb(vin)   
        thischarcode = ascb(midb(vin,i,1))   
        if thischarcode < &h80 then   
            strreturn = strreturn & chr(thischarcode)   
        else   
            nextcharcode = ascb(midb(vin,i+1,1))   
            strreturn = strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode))   
            i = i + 1   
        end if   
    next   
    bytes2bstr = strreturn   
end function  


使用方法: 

复制代码代码如下:


imgurl="http://www.163car.com/UpFile/CarImages/0092/S_b_20051241127326f6uew1s.jpg" '图片  
downimg(imgurl)  
imgurl="HTTP://login.zydn.net/news.asp" '文字页面  
downimg(imgurl) 

把代码保存为vbs文件,不需要iis就可以运行~