注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

jiwenxu的博客

CODE

 
 
 

日志

 
 

自动将远程页面的文件中的图片下载到本地  

2007-02-06 22:55:29|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

<%
'将本文保存为 save2local.asp
'测试:save2local.asp?url=http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html

'本文根据 chinahuman的《用asp自动解析网页中的图片地址,并将其保存到本地服务器》改编和优化
'自动创建目录,自动将原文件名更名,文件格式的限制以及其他功能的一些优化
'自动保存网页文件中 http://.... 格式的图片到本地
'转载请注明出处:http://www.jaron.cn http://www.csdn.net/develop
'参数设置开始
url = request("url")
localaddr = server.MapPath("images_remote/")'保存到本地的目录
localdir = "images_remote/" 'http 访问的相对路径
AllowFileExt = "jpg|bmp|png|gif" '支持的文件名格式
'参数设置完毕

if createdir(localaddr) = false then
response.Write "创建目录失败,请检查目录权限"
response.End
end if
response.Write Convert2LocalAddr(url,localaddr,localdir)

function Convert2LocalAddr(url,localaddr,localdir)
'参数说明
'url 页面地址
'localaddr 保存本地的物理地址
'localdir 相对路径
strContent = getHTTPPage(url)
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<img.+?>"
Set Matches =objRegExp.Execute(strContent)
For Each Match in Matches
RetStr = RetStr & GetRemoteImages(Match.Value)
Next
ImagesArray=split(RetStr,"||")
RemoteImage=""
LocalImage=""
for i=1 to ubound(ImagesArray)
if ImagesArray(i)<>"" andinstr(RemoteImage,ImagesArray(i))<1
then
fname=baseurl&cstr(i&mid(ImagesArray(i),instrrev(ImagesArray(i),".")))

ImagesFileName = ImagesArray(i)
AllowFileExtArray = split(AllowFileExt,"|")
isGetFile = false
for tmp = 0 to ubound(AllowFileExtArray)
if lcase(GetFileExt(ImagesFileName)) = ALlowFileExtArray(tmp)
then
isGetFile=True
end if
next
if isGetFile = true then
newfilename = GenerateRandomFileName(fname)
call Save2Local(ImagesFileName,localaddr & "/" &newfilename)
RemoteImage=RemoteImage&"||"& ImagesFileName
LocalImage=LocalImage&"||" & localdir &newfilename
end if
end if
next
arrnew=split(LocalImage,"||")
arrall=split(RemoteImage,"||")
for i=1 to ubound(arrnew)
strContent=replace(strContent,arrall(i),arrnew(i))
next
Convert2LocalAddr = strContent
end function

function GetRemoteImages(str)
Set objRegExp1 = New Regexp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = "http://.+? "
set mm=objRegExp1.Execute(str)
For Each Match1 in mm
tmpaddr = left(Match1.Value,len(Match1.Value)-1)
GetRemoteImages=GetRemoteImages&"||" &
replace(replace(tmpaddr,"""",""),"'","")
next
end function

function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then exit function
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function

Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
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

function getHTTPimg(url)
on error resume next
dim http
set http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then exit function
getHTTPimg=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function

function Save2Local(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttpimg(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
end function

function geturlencodel(byval url)'中文文件名转换
Dim i,code
geturlencodel=""
if trim(Url)="" then exit function
for i=1 to len(Url)
code=Asc(mid(Url,i,1))
if code<0 Then code = code + 65536
If code>255 Then
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)

else
geturlencodel=geturlencodel&mid(Url,i,1)
end if
next
end function

Function GenerateRandomFileName(ByVal szFilename)
'根据原文件名,自动以日期YYYY-MM-DD-RANDOM格式生成新文件名
Randomize
ranNum = Int(90000 * Rnd) + 10000
If Month(Now) < 10 Then c_month = "0" & Month(Now)Else
c_month = Month(Now)
If Day(Now) < 10 Then c_day = "0" & Day(Now) Else c_day=
Day(Now)
If Hour(Now) < 10 Then c_hour = "0" & Hour(Now) Else c_hour=
Hour(Now)
If Minute(Now) < 10 Then c_minute = "0" & Minute(Now)Else
c_minute = Minute(Now)
If Second(Now) < 10 Then c_second = "0" & Second(Now)Else
c_second = Minute(Now)
fileExt_a = Split(szFilename, ".")
FileExt = LCase(fileExt_a(UBound(fileExt_a)))
GenerateRandomFileName = Year(Now) & c_month & c_day &c_hour
& c_minute & c_second & "_" & ranNum & "."& FileExt
End Function

Function CreateDIR(ByVal LocalPath)'建立目录的程序,如果有多级目录,则一级一级的创建
On Error Resume Next
LocalPath = Replace(LocalPath, "\", "/")
Set FileObject =
server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
For I = 0 To path_level
If I = 0 Then pathtmp = patharr(0) & "/" Else pathtmp =
pathtmp & patharr(I) & "/"
cpath = Left(pathtmp, Len(pathtmp) - 1)
If Not FileObject.FolderExists(cpath) Then
FileObject.CreateFolder cpath
Next
Set FileObject = Nothing
If Err.Number <> 0 Then
CreateDIR = False
Err.Clear
Else
CreateDIR = True
End If
End Function

function GetfileExt(byval filename)
fileExt_a=split(filename,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
end function
%>

有一点要注意的是,这里只是分析了以
http开头的图片的地址。否则不下载图片,可以转换一下地址就行了,再提供几个小函数,分析地址用的:

Function findurl(thisurl)
if thisurl <> "" Then
findurl=""
strlen=InStr(8,thisurl,"/")
If strlen=0 Then strlen =1
findurl=Mid(thisurl,strlen,28)
end if
end Function

function findurlpath(thisurl)
thisurl = replace(thisurl,"//","@@")
ary_tmp = split(thisurl,"/")
for tmp = 0 to ubound(ary_tmp)
if tmp < ubound(ary_tmp) then
urltmp = urltmp & "/" & ary_tmp(tmp)
end if
next
urltmp = right(urltmp,len(urltmp)-1)
findurlpath = replace(urltmp,"@@","//") & "/"
end function

function findurlhost(thisurl)
thisurl = replace(thisurl,"//","@@")
ary_tmp = split(thisurl,"/")
urltmp = ary_tmp(0)
findurlhost = replace(urltmp,"@@","//") & "/"
findurlhost = left(findurlhost,len(findurlhost)-1)
end function

先选中一个你想 “偷” 的网页程序。。。
我这里看中了它。。呵呵 。。。很多妹妹图片。。。口水中。。
http://www.linkmm.com/photo/ads2.html
然后建立个ASP网页,先把以下代码复制进去
<%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

Url = "http://www.linkmm.com/photo/ads2.html";;;
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false)
oSend.send()
if err.number<>0 then
Response.write err.description
Response.End()
end if
SourceCode = bytes2BSTR(oSend.responseBody)%>

其中Url = "http://www.linkmm.com/photo/ads2.html";;;就是你想要偷
的网页,换成你需要的就可以了。。
这个时候response.write
一下。。是不是很多图片看不见啊。。不急,我们有replace呢。。把你现在的网页查看下原文件
把原来的网页查看下愿文件对比下就知道怎么让这些无法显示的显示出来。。。比起那些一个个replace替换图片的方法
用这个方法好多了就是在有src的地方在他前面直接替换网址多方便呵呵。。
在写这段代码。。程序就完了呵呵
<%baseurl1="http://www.linkmm.com/photo";;;
SourceCode
=replace(sourcecode,"src=""img/","src=""http://www.linkmm.com/photo/img/";;;)
SourceCode=replace(sourcecode,"new.gif",baseurl1&"/new.gif")
SourceCode
=replace(sourcecode,"href=""photo888","href=""http://www.linkmm.com/photo/photo888";;;)
SourceCode
=replace(sourcecode,"site.css","http://www.linkmm.com/photo/site.css";;;)
response.write SourceCode%>

是不是很简单啊。
完整代码如下:
<html>
<head>
<meta name="GENERATOR" content="Microsoft FrontPage5.0">
<meta name="rogId" content="FrontPage.Editor.Document">
<meta http-equiv="Content-Type" content="text/html;
charset=gb2312">
<meta http-equiv="refresh" content="3600">
<title></title>
</head>

<body>
<%
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

Url = "http://www.linkmm.com/photo/ads2.html";;;
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false)
oSend.send()
if err.number<>0 then
Response.write err.description
Response.End()
end if
SourceCode = bytes2BSTR(oSend.responseBody)
baseurl1="http://www.linkmm.com/photo";;;
SourceCode
=replace(sourcecode,"src=""img/","src=""http://www.linkmm.com/photo/img/";;;)
SourceCode=replace(sourcecode,"new.gif",baseurl1&"/new.gif")
SourceCode
=replace(sourcecode,"href=""photo888","href=""http://www.linkmm.com/photo/photo888";;;)
SourceCode
=replace(sourcecode,"site.css","http://www.linkmm.com/photo/site.css";;;)
response.write SourceCode
%>
</body>
</html>  

  评论这张
 
阅读(49)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018