Я прочитал статью о загрузке изображений с веб-страниц. Он может загружать изображения только с http-заголовком. Я внес некоторые улучшения. Он может загружать все ресурсы подключения на веб-странице и создавать локальный каталог в соответствии со структурой каталогов на веб-странице. для хранения ресурсов.
download.asp?url=Код download.asp
веб-страницы, которую вы хотите загрузить,
выглядит следующим образом:<%
Сервер.ScriptTimeout=9999
функция SaveToFile(из,вфайл)
при ошибке продолжить дальше
тусклый geturl, objStream, imgs
geturl=обрезать(из)
Mybyval = getHTTPstr (geturl)
Установите objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objstream.write
objstream.SaveToFile в файл, 2
объектный поток.Закрыть()
установить objstream=ничего
если номер ошибки＜＞0, то err.Clear
конечная функция
function geturlencodel(byval url)'преобразование имени файла на китайском языке
Дим я, код
geturlencodel=""
если Trim(Url)="" то выходим из функции
для i=1 до len(URL)
код = Asc (середина (Url, i, 1))
если код<0 Тогда код = код + 65536
Если код>255 Тогда
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
еще
geturlencodel=geturlencodel&mid(URL,i,1)
конец, если
следующий
конечная функция
функция getHTTPage (url)
при ошибке продолжить дальше
тусклый http
установите http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET", URL, false
HTTP.send()
если Http.readystate＜＞4, то выйдите из функции
getHTTPPage=bytes2BSTR(Http.responseBody)
установить http=ничего
если номер ошибки＜＞0, то err.Clear
конечная функция
Функция bytes2BSTR(vIn)
dim strReturn
dim я, ThisCharCode, NextCharCode
стрReturn = ""
Для i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Если ЭтотCharCode < &H80 Тогда
стрReturn = strReturn & Chr(ThisCharCode)
Еще
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
я = я + 1
Конец, если
Следующий
bytes2BSTR = стрReturn
завершения функции
getFileName(byval имя файла)
если instr(имя файла,"/")>0 тогда
fileExt_a=split(имя файла,"/")
getFileName=lcase(fileExt_a(ubound(fileExt_a)))
если instr(getFileName,"?")>0, то
getFileName=left(getFileName,instr(getFileName,"?")-1)
конец, если
еще
getFileName=имя файла
конец, если
завершения функции
getHTTPstr(url)
при ошибке продолжить дальше
тусклый http
установите http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET", URL, false
HTTP.send()
если Http.readystate＜＞4, то выйдите из функции
getHTTPstr=Http.responseBody
установить http=ничего
если номер ошибки＜＞0, то err.Clear
конечная функция
Функция CreateDIR(ByVal LocalPath) 'Программа для создания каталога. Если существует несколько уровней каталогов, создайте их один за другим. При ошибке возобновите следующий.
LocalPath = Заменить(LocalPath, "", "/")
Установите FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
Для I = 0 До path_level
Если I = 0, то pathtmp = patharr(0) & "/" Иначе pathtmp = pathtmp & patharr(I) & "/"
cpath = Left(pathtmp, Len(pathtmp) - 1)
Если не FileObject.FolderExists(cpath), то FileObject.CreateFolder cpath
Следующий
Установить FileObject = Ничего
Если Номер ошибки ＜＞ 0 Тогда
СоздатьКАТАЛ = Ложь
Ошиб.Очистить
Еще
СоздатьКАТАЛ = Истина
Конец, если
Конечная
функция функции GetfileExt(byval имя файла)
fileExt_a=split(имя файла,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
конечная функция
function getvirtual(str,path,urlhead)
если left(str,7)="http://" то
URL=str
elseif left(str,1)="/" тогда
start=instrRev(str,"/")
если начало = 1, то
URL="/"
еще
URL = влево (строка, начало)
конец, если
URL=urlhead&url
elseif left(str,3)="../" тогда
str1=mid(str,inStrRev(str,"../")+2)
ar=split(str,"../")
lv=ubound(ar)+1
ar=split(путь,"/")
URL="/"
для i=1 до (ubound(ar)-lv)
URL=url&ar(я)
следующий
URL=url&str1
URL=urlhead&url
еще
URL=urlhead&str
конец, если
getvirtual=URL
конечная функция
'Пример кода
dim dlpath
virtual="/downweb/"
truepath=server.MapPath(виртуальный)
если запрос("url")＜＞ "" тогда
URL = запрос («URL»)
fn = getFileName (url)
urlhead=left(url,(instr(replace(url,"//",""),"/")+1))
urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
strContent = getHTTPPage(url)
mystr=strContent
Установить objRegExp = Новое регулярное выражение
objRegExp.IgnoreCase = Истина
objRegExp.Global = Истина
objRegExp.Pattern = "(src|href)=.[^＞]+?"
Установить совпадения =objRegExp.Execute(strContent)
За каждый матч в матчах
str=Сопоставление.Значение
str=replace(str,"src=","")
str=replace(str,"href=","")
str=replace(str,"""","")
стр=заменить(строка,"'","")
имя_файла=GetfileName(str)
getRet=getVirtual(str,urlpath,urlhead)
temp=Replace(getRet,"//","**")
start=instr(temp,"/")
endt=instrRev(temp,"/")-start+1
если начало>0, то
repl=virtual&mid(temp,start)&" "
'response.Напишите ответ&"＜br＞"
mystr=Replace(mystr,str,repl)
dir=mid(temp,start,endt)
temp=truepath&Replace(каталог,"/","")
СоздатьDir (временно)
'response.Write getRet&"||"&temp&filename&"＜br＞＜br＞"
SaveToFile getRet,temp&имя файла
конец, если
Следующий
установить совпадения = ничего
конец, если
%>