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

汇总技巧

你快乐我快乐.... 汇集各类技巧,传播技巧,让我们共同熟练运用技巧..

 
 
 

日志

 
 

可下载目标网页上的所有图片代码  

2011-06-07 13:32:30|  分类: ◆ASP技巧 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

%
'参数设置开始
url = request("url")
localaddr = server.MapPath("pp/") '保存到本地的目录
localdir = "aa/" 'http 访问的相对路径
AllowFileExt = "jpg|bmp|png|gif|swf" '支持的文件名格式
'参数设置完毕
if createdir(localaddr) = false then
response.Write "创建目录失败,请检查目录权限"
response.End
end i
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)"" and instr(RemoteImage,ImagesArray(i))1 then
 fname=baseurlcstr(imid(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 i
 next
 if isGetFile = true then
 newfilename = GenerateRandomFileName(fname)
 call Save2Local(ImagesFileName,localaddr  "/"  newfilename)
 RemoteImage=RemoteImage"
" ImagesFileName
 LocalImage=LocalImage"
"  localdir  newfilename
 end i
 end i
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://.+?"
target=_blank>http://.+?">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.readystate4 then exit function
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number0 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.readystate4 then exit function
getHTTPimg=Http.responseBody
set http=nothing
if err.number0 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 code0 Then code = code + 65536
 If code255 Then
 geturlencodel=geturlencodel"%"Left(Hex(Code),2)"%"Right(Hex(Code),2)
 else
 geturlencodel=geturlencodelmid(Url,i,1)
 end i
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 cpat
 Next
 Set FileObject = Nothing
 If Err.Number  0 Then
 CreateDIR = False
 Err.Clear
 Else
 CreateDIR = True
 End I
End Function
function GetfileExt(byval filename)
fileExt_a=split(filename,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
end function
%
(出处:Viphot)

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

历史上的今天

在LOFTER的更多文章

评论

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

页脚

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