ASP Escriba el programa para descargar todos los recursos en la página web

De %

Server.scripttimeout = 9999

Función savetofile (desde, tofile)

En el currículum de error siguiente

Dim geturl, objstream, imgs

getURL = TRIM (de)

Mybyval = getttpstr (getUrl)

Establecer objstream = server.createObject (ADODB.Stream)

objstream.type = 1

objstream.

objstream.write mybyval

objstream.savetofile tofile, 2

objstream.close ()

establecer objstream = nada

if Err.number <> 0 el Err.Clear

función final

Función getUrlencodel (URL BYVAL) 'Conversión de nombre de archivo chino

Dim I, código

getUrlencodel =

Si TRIM (URL) = entonces salga de la función

Para i = 1 a Len (URL)

Código = ASC (Mid (URL, I, 1))

if código <0 thatn código = código 65536

Si el código ＞ 255 entonces

GetUrlencodel = getUrlencodel &%& Left (hex (código), 2) y%y derecha (hex (código), 2)

demás

getUrlencodel = getUrlencodel & Mid (url, i, 1)

final si

próximo

función final

Función gethttppage (URL)

En el currículum de error siguiente

Dim http

Establecer http = server.CreateObject (msxml2.xmlhttp)

Http.open get, url, falso

Http.send ()

Si http.readyState <> 4 la función de salida

Gethttppage = bytes2bstr (http.ResponseBody)

Establecer http = nada

if Err.number <> 0 el Err.Clear

función final

Función bytes2bstr (vin)

Dim strreturn

Dim I, ThisCharCode, NextCharcode

Strreturn =

Para i = 1 a Lenb (vin)

ThisCharCode = ASCB (MidB (Vin, I, 1))

Si thisCharCode <& H80 entonces

Strreturn = strreturn & chr (thisCharcode)

Demás

Nextcharcode = ascb (midb (vin, i 1,1)))

Strreturn = strreturn & chr (clng (thisCharcode) * & H100 cint (nextcharcode)))

i = i 1

Final si

Próximo

bytes2bstr = strreturn

Función final

Función getFileName (nombre de archivo BYVAL)

If instr (nombre de archivo,/) ＞ 0 entonces

filext_a = split (nombre de archivo,/)

GetFileName = lcase (fileext_a (Ubound (filext_a))

Si instrer (getFileName,?) ＞ 0 entonces

getFileName = Left (getFileName, instr (getFileName,?)-1)

final si

demás

getFileName = FileName

final si

función final

Función gethttpstr (URL)

En el currículum de error siguiente

Dim http

Establecer http = server.CreateObject (msxml2.xmlhttp)

Http.open get, url, falso

Http.send ()

Si http.readyState <> 4 la función de salida

Gethttpstr = http.ResponseBody

Establecer http = nada

if Err.number <> 0 el Err.Clear

función final

Función CreateIR (BYVAL LocalPath) para crear un programa de directorio, si hay múltiples directorio, luego la creación de nivel y un nivel

En el currículum de error siguiente

Localpath = reemplazar (localpath, /, /)

Establecer fileObject = server.CreateObject (scripting.filesystemObject)

Patharr = Split (LocalPath, /)

Path_level = Ubound (Patharr)

Para i = 0 a path_level

If i = 0 thatn pathtmp = patharr (0) & / else pathtmp = pathtmp & patharr (i) & / / /

Cpath = izquierda (pathtmp, len (pathtmp) - 1)

Si no es fileObject.FoldeRexist (CPATH) el archivoObject.CreateFolder CPATH

Próximo

Establecer fileObject = nada

Si err.number <> 0 entonces

Creationir = falso

Err.Clear

Demás

Creationir = true

Final si

Función final

Función getFileExt (nombre de archivo BYVAL)

filext_a = split (nombre de archivo ,.)

GetFileExt = lcase (fileext_a (Ubound (filext_a))

función final

Función getVirtual (str, ruta, urlhead)

Si se deja (str, 7) = http: // entonces

url = str

Elseif a la izquierda (str, 1) =/ luego

Start = instrrev (str,/)

Si inicia = 1 entonces

url =/

demás

url = izquierda (str, inicio)

final si

url = urlhead y url

Elseif a la izquierda (str, 3) = ../ Entonces

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

Ar = split (str, ../)

LV = Ubound (AR) 1

AR = Split (ruta,/)

url =/

para i = 1 a (Ubound (AR) -lv)

url = url y ar (i)

próximo

URL = URL y STR1

url = urlhead y url

demás

url = urlhead y fuerte

final si

getVirtual = url

función final

'Código de ejemplo

Dim dlpath

virtual =/descargar/

truePath = server.mappath (virtual)

Si solicita (URL) <> entonces

URL = solicitud (URL)

fn = getFileName (URL)

urlhead = izquierda (URL, (Instr (Reemplazar (URL, //,),/))

urlpath = reemplazar (izquierda (url, instrrev (url,/)), urlhead,)

StrContent = gethttppage (url)

Mystr = strContent

Establecer objregexp = new Regexp

objegexp.ignorecase = True

objregexp.global = verdadero

objegexp.pattern = (src | href) =.

Establecer coincidencias = objegexp.execute (strContent)

Para cada partido en partidos

str = Match.Value

str = reemplazar (str, src =,)

str = reemplazar (str, href =,)

str = reemplazar (str ,,)

str = reemplazar (str ',)

FileName = getFileName (STR)

getret = getVirtual (str, urlpath, urlhead)

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

Start = instr (temp,/)

Endt = instrrev (temp,/)-Inicio 1

Si comienza ＞ 0 entonces

Repl = virtual & mid (temp, start) &

'Response.Write Reply & <br>

mystr = reemplazar (mystr, str, repl)

Dir = Mid (temp, start, endt)

temp = truePath & reemplazar (dir,/,/)

Creadoir (temp)

'Response.Write Getret & || & Temp & FileName & <br> <br>

Savetofile getret, prueba y nombre de archivo

final si

Próximo

Establecer coincidencias = nada

final si

%>