 |
|
|
 首页 |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
以前发过一个东西,是将远程的内容,按浏览器输入后,将它转为二进制流下载到本地,但局限性比较多,这个代码可以将远程页面的所有内容,包括远程服务器的CSS,JS,JPG,Gif,第一层下面的页面,swf,等等... 代码的使用: 将下面的代码保存为downfile.asp放到你的站点一个目录下,然后在那个目录里面建立一个叫downfile的文件夹,所有得到的内容都将保存在downfile文件夹里。 在浏览器中输入 http://你的地址/downfile.asp?url=http://www.baidu.com/index.html 那么就将百度首页的所有文件都下载到本地的那个叫downfile的文件夹中.. 这个代码比你的手工OE可要舒适多了,而且会将获取的文件,按照原来远程的路径,建立文件夹,分类别保存文件.. <% \\\'#################### \\\'代码的主体函数部分均源自于网络 \\\'#################### \\\'设置超时的时间 Server.ScriptTimeout=9999 \\\'############## \\\'文件保存函数 \\\'############# function SaveToFile(from,tofile) on error resume next dim geturl,objStream,imgs geturl=trim(from) Mybyval=getHTTPstr(geturl) Set objStream = Server.CreateObject("ADODB.Stream") objStream.Type =1 objStream.Open objstream.write Mybyval objstream.SaveToFile tofile,2 objstream.Close() set objstream=nothing if err.number<>0 then err.Clear 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 \\\'############## \\\'XML获取远程页面开始 \\\'############# 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 \\\'############## \\\'XML获取远程页面结束,这段是小偷程序都通用的部分 \\\'############# \\\'############## \\\'分解地址,取得文件名 \\\'############# function getFileName(byval filename) if instr(filename,"/")>0 then fileExt_a=split(filename,"/") getFileName=lcase(fileExt_a(ubound(fileExt_a))) if instr(getFileName,"?")>0 then getFileName=left(getFileName,instr(getFileName,"?")-1) end if else getFileName=filename end if end function \\\'############## \\\'获取远程页面函数 \\\'############# function getHTTPstr(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 getHTTPstr=Http.responseBody set http=nothing if err.number<>0 then err.Clear end function \\\'############## \\\'FSO处理函数,创建目录 \\\'############# 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 \\\'############## \\\'如何获取虚拟的路径 \\\'############# 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="/downfile/" 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>" response.Write "成功取得"&filename&"这个文件<br>" response.Write "并将"&filename&"保存在"&temp&"<br><br>" response.Write "<HR>" SaveToFile getRet,temp&filename end if Next set Matches=nothing else response.write "请输入一个地址!" end if %> 返回类别: 教程 上一教程: 向 WEB 窗体页添加 REPEATER 控件 下一教程: 一个不太让人讨厌的自动弹出窗口 您可以阅读与"利用ASP程序实现将远程页面的所有内容下载到本地"相关的教程: · 自动将远程页面的文件中的图片下载到本地服务器 · 用ASP实现远程抓取网页到本地数据库 · 不刷新页面的情况下调用远程ASP · ASP小偷程序如何利用XMLHTTP实现表单的提交以及COOKIES或SESSION的发送 · ASP程序实现在HTML中显示文章被阅读的次数 |
  |
| 快精灵印艺坊 版权所有 |
首页 会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店
|
||
