一次性下載遠程頁面上的所有內容
使用方法,將上面的代碼保存為一個比如:downfile.asp
在瀏覽器上輸入:
http://你的地址/downfile.asp?url=http://www.baidu.com/index.html
<% '設置超時的時間 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 學習交流
熱門圖片
猜你喜歡的新聞
新聞熱點 2019-10-23 09:17:05
2019-10-21 09:20:02
2019-10-21 09:00:12
2019-09-26 08:57:12
2019-09-25 08:46:36
2019-09-25 08:15:43
疑難解答 |