Eu li um artigo sobre como baixar imagens de páginas da web. Ele só pode baixar imagens com cabeçalho http. Ele pode baixar todos os recursos de conexão da página da web e criar um diretório local de acordo com a estrutura de diretórios da página da web. para armazenar os recursos.
O código download.asp da
página que você deseja baixar
é o seguinte<%
Servidor.ScriptTimeout=9999
função SaveToFile(de,paraarquivo)
em caso de erro, retome a seguir
dim geturl,objStream,imgs
geturl=cortar(de)
Mybyval=getHTTPstr(geturl)
Definir objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objstream.write Mybyval
objstream.SaveToFile tofile,2
objstream.Fechar()
definir objstream = nada
se err.número<>0 então err.Clear
função final
função geturlencodel(byval url)'Conversão de nome de arquivo chinês
Escurecer eu, código
geturlencodel=""
se trim(Url)="" então saia da função
para i=1 para len(Url)
código=Asc(meio(Url,i,1))
se código<0 Então código = código + 65536
Se código>255 Então
geturlencodel=geturlencodel&"%"&Left(Hex(Código),2)&"%"&Right(Hex(Código),2)
outro
geturlencodel=geturlencodel&mid(Url,i,1)
terminar se
próximo
função final
função getHTTPage(url)
em caso de erro, retome a seguir
escurecer http
definir http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET",url,falso
http.send()
se Http.readystate<>4 então saia da função
getHTTPPage=bytes2BSTR(Http.responseBody)
definir http = nada
se err.número<>0 então err.Clear
função final
Função bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
Para i = 1 para LenB(vIn)
EsteCharCode = AscB(MidB(vIn,i,1))
Se ThisCharCode <&H80 Então
strReturn = strReturn & Chr(ThisCharCode)
Outro
PróximoCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
eu = eu + 1
Terminar se
Próximo
bytes2BSTR = strReturn
Função final
função getFileName (byval nome do arquivo)
if instr(nome do arquivo,"/")>0 então
arquivoExt_a=split(nome do arquivo,"/")
getNomeArquivo=lcase(arquivoExt_a(ubound(arquivoExt_a)))
se instr(getNomeArquivo,"?")>0 então
getNomeArquivo=left(getNomeArquivo,instr(getNomeArquivo,"?")-1)
terminar se
outro
getNomeArquivo=nome do arquivo
terminar se
função final
função getHTTPstr(url)
em caso de erro, retome a seguir
escurecer http
definir http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,falso
http.send()
se Http.readystate<>4 então saia da função
getHTTPstr=Http.responseBody
definir http = nada
se err.número<>0 então err.Clear
função final
Função CreateDIR(ByVal LocalPath) 'Programa para criar um diretório Se houver vários níveis de diretórios, crie-os um por um.
Em caso de erro, retomar o próximo
LocalPath = Substituir(LocalPath, "", "/")
Definir FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Dividir(LocalPath, "/")
path_level = UBound(patharr)
Para I = 0 Para path_level
Se I = 0 Então pathtmp = patharr(0) & "/" Else pathtmp = pathtmp & patharr(I) & "/"
cpath = Esquerda(caminhotmp, Len(caminhotmp) - 1)
Se não for FileObject.FolderExists(cpath), então FileObject.CreateFolder cpath
Próximo
Definir FileObject = Nada
Se Err.Number <> 0 Então
CriarDIR = Falso
Err.Limpar
Outro
CriarDIR = Verdadeiro
Terminar se
Função final
função GetfileExt (byval nome do arquivo)
arquivoExt_a=split(nome do arquivo,".")
GetfileExt=lcase(arquivoExt_a(ubound(arquivoExt_a)))
função final
função getvirtual(str,caminho,urlhead)
se esquerda(str,7)="http://"então
url=str
elseif esquerda(str,1)="/"então
start=instrRev(str,"/")
se início = 1 então
url="/"
outro
url=esquerda(str,início)
terminar se
url=urlhead&url
elseif esquerda(str,3)="../"então
str1=meio(str,inStrRev(str,"../")+2)
ar=dividir(str,"../")
lv=ubound(ar)+1
ar=dividir(caminho,"/")
url="/"
para i=1 para (ubound(ar)-lv)
url=url&ar(i)
próximo
url=url&str1
url=urlhead&url
outro
url=urlhead&str
terminar se
getvirtual=url
função final
'Código de exemplo
dim dlpath
virtual="/downweb/"
truepath=server.MapPath(virtual)
if request("url")<> "" then
url=solicitação("url")
fn=getNomeArquivo(url)
urlhead=left(url,(instr(replace(url,"//",""),"/")+1))
urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
strContent = getHTTPPage(url)
mystr=strConteúdo
Definir objRegExp = Novo Regexp
objRegExp.IgnoreCase = Verdadeiro
objRegExp.Global = Verdadeiro
objRegExp.Pattern = "(src|href)=.[^>]+? "
Definir correspondências =objRegExp.Execute(strContent)
Para cada partida nas partidas
str = Correspondência.Valor
str=substituir(str,"src=","")
str=substituir(str,"href=","")
str=substituir(str,"""","")
str=substituir(str,"'","")
nome do arquivo=GetfileName(str)
getRet=getVirtual(str,urlpath,urlhead)
temp=Substituir(getRet,"//","**")
start=instr(temp,"/")
endt=instrRev(temp,"/")-start+1
se início>0 então
repl=virtual&mid(temp,início)&" "
'resposta.Escrever resposta&"<br>"
mystr=Substituir(mystr,str,repl)
dir=mid(temp,início,fim)
temp=truepath&Replace(dir,"/","")
CriarDir(temp)
'response.Write getRet&"||"&temp&nomedoarquivo&"<br><br>"
SaveToFile getRet,temp&nome do arquivo
terminar se
Próximo
definir correspondências = nada
terminar se
%>