Baixe todo o conteúdo de uma página remota de uma só vez

'Definir o tempo limite

Servidor.ScriptTimeout=9999

'##############

'Função para salvar arquivo

'#############

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

'##############

'Substituição de processamento de caracteres

'#############

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

'##############

'A aquisição XML da página remota é iniciada

'#############

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

'##############

'A aquisição XML de páginas remotas termina. Esta seção é comum a todos os programas de ladrões.

'#############

'##############

'Decomponha o endereço e obtenha o nome do arquivo

'#############

função getFileName (byval nome do arquivo)

se 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

'##############

'Obter função de página remota

'#############

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 de processamento FSO, criar diretório

'#############

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(pathtmp, Len(pathtmp) - 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)

fileExt_a=split(nome do arquivo,.)

GetfileExt=lcase(arquivoExt_a(ubound(arquivoExt_a)))

função final

'##############

'Como obter o caminho virtual

'#############

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 = divisão (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

'Cria uma pasta para armazenar os dados adquiridos

virtual=/downweb/

truepath = servidor.MapPath (virtual)

se solicitação(url)<> então

url=solicitação(url)

fn=getNomeArquivo(url)

urlhead=esquerda(url,(instr(substituir(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.Escreva resposta&<br>

mystr=Substituir(mystr,str,repl)

dir=meio(temperatura,início,fim)

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

CriarDir(temp)

resposta.Escreva getRet&||&temp&nomedoarquivo&<br>

response.Write obteve com sucesso o arquivo &filename&<br>

resposta.Escreva e salve &nomedoarquivo& em &temp&<br><br>

resposta.Escreva <HR>

SaveToFile getRet,temp&nome do arquivo

terminar se

Próximo

definir correspondências = nada

terminar se

%>