ASP Напишите программу для загрузки всех ресурсов на веб -странице

%

Server.ScriptTimeout = 9999

Функция Savetofile (от, тофиль)

При ошибке резюме следующим

dim geturl, objstream, imgs

geturl = trim (от)

Mybyval = getttpstr (geturl)

Установить objstream = server.createObject (adodb.stream)

objstream.type = 1

objstream.open

objstream.write mybyval

objstream.savetofile tofile, 2

objstream.close ()

установить objstream = ничего

Если err.number <> 0 err.clear

конечная функция

Функция getUrlencodel (byval url) 'преобразование имени китайского файла

Dim I, код

geturlencodel =

Если trim (url) = тогда функция выхода

для i = 1 к Len (URL)

Code = asc (mid (url, i, 1))

Если код <0 код, код 65536

Если код ＞ 255, то тогда

Geturlencodel = geturlencodel &%и lef (hex (код), 2) и%и правый (hex (код), 2)

еще

geturlencodel = geturlencodel & mid (url, i, 1)

конец, если

следующий

конечная функция

Функция gethttppage (url)

При ошибке резюме следующим

Dim http

Установить http = server.createObject (msxml2.xmlhttp)

Http.open get, url, false

Http.send ()

Если http.readystate <> 4 функция выхода

Gethttppage = bytes2bstr (http.responsebody)

Установить http = ничего

Если err.number <> 0 err.clear

конечная функция

Функция Bytes2BSTR (VIN)

Dim Strreturn

Dim I, ThisChode, NextChode

Strreturn =

Для i = 1 к Lenb (VIN)

ThisChode = ASCB (MIDB (VIN, I, 1))

Если этот код <& H80, тогда

Strreturn = strreturn & chr (this charcode)

Еще

NextChode = ASCB (MIDB (VIN, I 1,1)))))))

Strreturn = strreturn & chr (clng (thisChode) * & h100 cint (nextcharcode)))

i = 1 1

Конец, если

Следующий

Bytes2bstr = strreturn

Конечная функция

Function getFilename (Byval filename)

Если instr (имя файла,/) ＞ 0, тогда

filext_a = split (имя файла,/)

GetFilename = lcase (fileExt_a (ubound (filext_a))

Если instr (getFileName,?) ＞ 0, тогда

GetFilEname = Left (GetFilename, instr (getFilename,?)-1)

конец, если

еще

GetFilEname = имя файла

конец, если

конечная функция

Функция gethttpstr (url)

При ошибке резюме следующим

Dim http

Установить http = server.createObject (msxml2.xmlhttp)

Http.open get, url, false

Http.send ()

Если http.readystate <> 4 функция выхода

Gethttpstr = http.responsebody

Установить http = ничего

Если err.number <> 0 err.clear

конечная функция

Функция CenectiRIR (Byval LocalPath) для создания программы каталогов, если есть несколько каталогов, то уровень и один уровень.

При ошибке резюме следующим

LocalPath = заменить (localPath, /, /)

Set fileObject = server.createObject (scripting.filesystemobject)

patharr = split (localpath, /)

path_level = ubound (patharr)

Для i = 0 to path_level

Если i = 0 that pathtmp = patharr (0) и else pathtmp = pathtmp & patharr (i) & / / / /

CPATH = LEAND (PATHTMP, LEN (PATHTMP) - 1)

Если не fileobject.foldRexist (cpath) fileobject.createfolder cpath

Следующий

Установить FileObject = ничего

Если err.number <> 0, тогда

CenectiR = false

Err.clear

Еще

CenectiR = true

Конец, если

Конечная функция

Функция getFileext (byval filename)

filext_a = split (имя файла ,.)

GetFileext = lcase (fileext_a (ubound (filext_a)))

конечная функция

Функция getVirtual (str, path, urlhead)

Если осталось (str, 7) = http: // there

url = str

elseif Left (str, 1) =/ Затем

Start = instrrev (str,/)

Если старт = 1, тогда

url =/

еще

url = слева (str, start)

конец, если

url = urlhead & url

elseif Left (str, 3) = ../ Затем

Str1 = mid (str, instrrev (str, ../) 2) 2)

Ar = split (str, ../)

lv = ubound (ar) 1

Ar = split (path,/)

url =/

для i = 1 до (ubound (ar) -lv)

url = url & ar (i)

следующий

url = url & str1

url = urlhead & url

еще

url = urlhead & strong

конец, если

getVirtual = url

конечная функция

'Пример кода

Dim dlpath

virtual =/скачать/

truepath = server.mappath (виртуальный)

Если запрос (URL) <> тогда

url = запрос (URL)

fn = getFilename (URL)

urlhead = left (url, (instr (url (url, //,),/))

urlpath = reply (left (url, instrrev (url,/)), urlhead,)

Strcontent = gethttppage (url)

Mystr = strcontent

Установить objregexp = new Regexp

objregexp.ignorecase = true

objregexp.global = true

objregexp.pattern = (src | href) =.

SET MATCHES = objregexp.execute (strcontent)

Для каждого матча в матчах

str = match.value

str = заменить (str, src =,)

str = заменить (str, href =,)

str = заменить (str ,,)

str = заменить (str, ',)

filename = getFilename (Str)

getret = getVirtual (str, urlpath, urllead)

temp = reply (getret, //, **)

Start = instr (Temp,/)

Endt = instrrev (temp,/)-начало 1

Если начать ＞ 0, тогда

Repl = Virtual & Mid (Temp, Start) и

'Response.write Repl & <br>

MyStr = заменить (mystr, str, repl)

Dir = mid (Temp, start, endt)

temp = truepath & reply (dir,/,/)

CenectiR (TEMP)

'Response.write getret & ||

Savetofile getret, тест и имя файла

конец, если

Следующий

установить совпадения = ничего

конец, если

%>