ASP VBS xmlhttp adodbstream下载和保存图片(新闻小偷)

 函数:

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就可以运行~

posted @ 2006-10-27 09:53  MultiThread-PHP  阅读(404)  评论(0编辑  收藏  举报