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
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)
downimg(imgurl)
imgurl="HTTP://login.zydn.net/news.asp" '文字页面
downimg(imgurl)
把代码保存为vbs文件,不需要iis就可以运行~