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

转载于:https://www.cnblogs.com/Iamlein/archive/2006/10/27/2375959.html