Download and save the image code using asp vbs xmlhttp adodbstream

Function:

Copy codeThe Code is as follows: function saveFile (data, recfilen)
Set Astream = CreateObject ("Adodb. Stream") 'asp Server. CreateObject ("Adodb. Stream ")
Fxt = mid (recfilen, limit Rev (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
'Admodemo-exclusive = 12
'Admodeunknown = 0
'Admodewrite = 2
Astream. open
'Astream. CharSet = "GB2312"
'Astream. LoadFromFile (recfilen) 'loads the file
'Assp = Astream. size
Astream. Position = 0' is set to Assp when loading files
'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, limit Rev (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) 'binary conversion to Chinese Characters
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

Usage:Copy codeCode: imgurl = "http://www.163car.com/UpFile/CarImages/0092/S_ B _20051241127326f6uew1s.jpg" 'image
Downimg (imgurl)
Imgurl = "HTTP: // login.zydn.net/news.asp" 'text page
Downimg (imgurl)

Save the code as a vbs file and run it without iis ~