发送文章__当百网

文章·资料	电脑软件	手机软件	网站源码
电脑·手机·网络学习话题娱乐故事文化·历史国学典籍法律法规	操作系统网络办公·文件音频视频图形图像硬件·驱动程序行业教学学习编程游戏	安卓苹果鸿蒙其他	ASP ASP.NET JSP PHP HTML·CSS·JavaScript

本站搜索

发送文章

用ASP编写下载网页中所有资源的程序

〖评论()〗〖留言〗〖收藏〗

收信地址

填写收信人的电子邮箱

邮件主题

填写邮件主题

邮件内容

看过一篇关于下载网页中图片的文章，它只能下载以http头的图片，我做了些改进，可以下载网页中的所有连接资源，并按照网页中的目录结构建立本地目录，存放资源。 　　download.asp?url=你要下载的网页 　　download.asp代码如下： ＜% Server.ScriptTimeout=9999 functionSaveToFile(from,tofile) onerrorresumenext dimgeturl,objStream,imgs geturl=trim(from) Mybyval=getHTTPstr(geturl) SetobjStream=Server.CreateObject("ADODB.Stream") objStream.Type=1 objStream.Open objstream.writeMybyval objstream.SaveToFiletofile,2 objstream.Close() setobjstream=nothing iferr.number＜＞0thenerr.Clear endfunction functiongeturlencodel(byvalurl)’中文文件名转换 Dimi,code geturlencodel="" iftrim(Url)=""thenexitfunction fori=1tolen(Url) code=Asc(mid(Url,i,1)) ifcode＜0Thencode=code+65536 Ifcode＞255Then geturlencodel=geturlencodel"%"Left(Hex(Code),2)"%"Right(Hex(Code),2) else geturlencodel=geturlencodelmid(Url,i,1) endif next endfunction functiongetHTTPPage(url) onerrorresumenext dimhttp sethttp=Server.createobject("Msxml2.XMLHTTP") Http.open"GET",url,false Http.send() ifHttp.readystate＜＞4thenexitfunction getHTTPPage=bytes2BSTR(Http.responseBody) sethttp=nothing iferr.number＜＞0thenerr.Clear endfunction Functionbytes2BSTR(vIn) dimstrReturn dimi,ThisCharCode,NextCharCode strReturn="" Fori=1ToLenB(vIn) ThisCharCode=AscB(MidB(vIn,i,1)) IfThisCharCode＜H80Then strReturn=strReturnChr(ThisCharCode) Else NextCharCode=AscB(MidB(vIn,i+1,1)) strReturn=strReturnChr(CLng(ThisCharCode)*H100+CInt(NextCharCode)) i=i+1 EndIf Next bytes2BSTR=strReturn EndFunction functiongetFileName(byvalfilename) ifinstr(filename,"/")＞0then fileExt_a=split(filename,"/") getFileName=lcase(fileExt_a(ubound(fileExt_a))) ifinstr(getFileName,"?")＞0then getFileName=left(getFileName,instr(getFileName,"?")-1) endif else getFileName=filename endif endfunction functiongetHTTPstr(url) onerrorresumenext dimhttp sethttp=server.createobject("MSXML2.XMLHTTP") Http.open"GET",url,false Http.send() ifHttp.readystate＜＞4thenexitfunction getHTTPstr=Http.responseBody sethttp=nothing iferr.number＜＞0thenerr.Clear endfunction FunctionCreateDIR(ByValLocalPath)’建立目录的程序，如果有多级目录，则一级一级的创建 　OnErrorResumeNext 　LocalPath=Replace(LocalPath,"\","/") 　SetFileObject=server.CreateObject("Scripting.FileSystemObject") 　patharr=Split(LocalPath,"/") 　path_level=UBound(patharr) 　ForI=0Topath_level 　　IfI=0Thenpathtmp=patharr(0)"/"Elsepathtmp=pathtmppatharr(I)"/" 　　　cpath=Left(pathtmp,Len(pathtmp)-1) 　　IfNotFileObject.FolderExists(cpath)ThenFileObject.CreateFoldercpath 　Next 　SetFileObject=Nothing 　IfErr.Number＜＞0Then 　　CreateDIR=False 　　Err.Clear 　Else 　　CreateDIR=True 　EndIf EndFunction functionGetfileExt(byvalfilename) 　fileExt_a=split(filename,".") 　GetfileExt=lcase(fileExt_a(ubound(fileExt_a))) endfunction functiongetvirtual(str,path,urlhead) 　ifleft(str,7)="http://"then 　　url=str 　elseifleft(str,1)="/"then 　　start=instrRev(str,"/") 　　ifstart=1then 　　　url="/" 　　else 　　　url=left(str,start) 　　endif 　　url=urlheadurl 　　elseifleft(str,3)="../"then 　　str1=mid(str,inStrRev(str,"../")+2) 　　ar=split(str,"../") 　　lv=ubound(ar)+1 　　ar=split(path,"/") 　　url="/" 　　fori=1to(ubound(ar)-lv) 　　　url=urlar(i) 　　next 　　url=urlstr1 　　url=urlheadurl 　else 　　url=urlheadstr 　endif 　getvirtual=url endfunction ’示例代码 dimdlpath virtual="/downweb/" truepath=server.MapPath(virtual) ifrequest("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 　SetobjRegExp=NewRegexp 　objRegExp.IgnoreCase=True 　objRegExp.Global=True 　objRegExp.Pattern="(src|href)=.[^\＞]+?" 　SetMatches=objRegExp.Execute(strContent) 　ForEachMatchinMatches 　　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 　　ifstart＞0then 　　　repl=virtualmid(temp,start)"" 　　　’response.Writerepl"＜br＞" 　　　mystr=Replace(mystr,str,repl) 　　dir=mid(temp,start,endt) 　　temp=truepathReplace(dir,"/","\") 　　CreateDir(temp) 　　’response.WritegetRet"||"tempfilename"＜br＞＜br＞" 　　SaveToFilegetRet,tempfilename 　endif Next setMatches=nothing endif %＞<br /><br />文章网址：<a href="https://dangbai.cn/Article.asp?ID=10000545" target="_blank">https://dangbai.cn/Article.asp?ID=10000545</a>

填写邮件内容

发信地址

填写发信人的电子邮箱

邮件签名

填写邮件签名

验证码

填写验证码，单击刷新验证码

发送协议

·欢迎使用本站在线文章发送系统。
·不得使用本站在线发送邮件系统发送垃圾邮件、广告邮件。
·如果收信人地址或其服务器出现错误，可能无法成功发送。
·如果有什么问题，或者意见建议，请联系［网站管理员］。

当百网

本站使用【啊估文章软件站】网站系统〖网站管理员留言簿〗