Download all content on the remote page at once
To use, save the above code as a file such as: downfile.asp
Type in your browser:
http://your address/downfile.asp?url=http://www.baidu.com/index.html
<% 'Set the timeout Server.ScriptTimeout=9999 '############## 'File save function '############# 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 '############## 'Character processing replacement '############# function geturlencodel(byval url)'Chinese file name conversion 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 acquisition of remote page starts '############# function getHTTPage(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 acquisition of remote page ends. This section is common to all thieves' programs. '############# '############## 'Decompose the address and obtain the file name '############# 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 '############## 'Get remote page 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 processing function, create directory '############# Function CreateDIR(ByVal LocalPath) 'Program to create a directory. If there are multiple levels of directories, create them one by one. 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 '############## 'How to get the virtual path '############# 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 |
'Example code
dim dlpath 'Create a folder to store the acquired data 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> response.Write successfully obtained the file &filename&<br> response.Write and save &filename& in &temp&<br><br> response.Write <HR> SaveToFile getRet,temp&filename end if Next set Matches=nothing end if %> |