| 网站首页 | 文章中心 | 电子书下载 | 矢量图库 | 视频教程 | 素材下载 | 程序代码下载 | JS代码 | 论坛 | 
常用软件类:
|杀毒安全 |联络聊天 |网络软件 |多媒体类 |系统工具 |图形图像 |系统工具 |应用软件 |行业软件
开发设计类:
|动画制作 |图像处理 |3D设计 |操作系统 |站长学院 |网络相关 |WEB设计 |数据库类 |程序开发
教你一次下载网页中的所有资源
作者:佚名    文章来源:不详    点击数:    更新时间:2006-9-14
  h = 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

function getvirtual(str,path,urlhead)
if left(str,7)="http://" then
url=str
elseif left(str,1)="/" then
start=instrRev(str,"/")
if start=1 then
url="/"
else
url=left(str,start)
end if
url=urlhead&url
elseif left(str,3)="../" then
str1=mid(str,inStrRev(str,"../")+2)
ar=split(str,"../")
lv=ubound(ar)+1
ar=split(path,"/")
url="/"
for i=1 to (ubound(ar)-lv)
url=url&ar(i)
next
url=url&str1
url=urlhead&url
else
url=urlhead&str
end if
getvirtual=url
end function
'示例代码
dim dlpath

virtual="/downweb/"
truepath=server.MapPath(virtual)

if request("url")<> "" then
url=request("url")
fn=getFileName(url)
urlhead=left(url,(instr(replace(url,"//",""),"/")+1))
urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
strContent = getHTTPPage(url)
mystr=strContent
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "(src|href)=.[^\>]+? "
Set Matches =objRegExp.Execute(strContent)
For Each Match in Matches
str=Match.Value
str=replace(str,"src=","")
str=replace(str,"href=","")
str=replace(str,"""","")
str=replace(str,"'","")
filename=GetfileName(str)
getRet=getVirtual(str,urlpath,urlhead)
temp=Replace(getRet,"//","**")
start=instr(temp,"/")
endt=instrRev(temp,"/")-start+1
if start>0 then
repl=virtual&mid(temp,start)&" "
'response.Write repl&"<br>"
mystr=Replace(mystr,str,repl)

dir=mid(temp,start,endt)
temp=truepath&Replace(dir,"/","\")
CreateDir(temp)
'response.Write getRet&"||"&temp&filename&"<br><br>"
SaveToFile getRet,temp&filename
end if
Next
set Matches=nothing
end if
%>
 

上一页  [1] [2] 


相关文章