J'ai lu un article sur le téléchargement d'images à partir de pages Web. Il ne peut télécharger que des images avec un en-tête http. J'ai apporté quelques améliorations. Il peut télécharger toutes les ressources de connexion dans la page Web et créer un répertoire local en fonction de la structure des répertoires de la page Web. pour stocker les ressources.
download.asp?url=Le code download.asp de
la page Web que vous souhaitez télécharger
est le suivant :<%
Serveur.ScriptTimeout=9999
fonction SaveToFile (de, vers fichier)
en cas d'erreur, reprendre ensuite
faible geturl, objStream, imgs
geturl=trim(de)
Monbyval=getHTTPstr(geturl)
Définir objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write Mybyval
objstream.SaveToFile dans un fichier,2
objstream.Close()
définir objstream = rien
si err.number＜＞0 alors err.Clear
fonction de fin
fonction geturlencodel(byval url)'Conversion du nom de fichier chinois
Dim je, code
geturlencodel=""
si trim(Url)="" alors quittez la fonction
pour i=1 à len(Url)
code=Asc(milieu(Url,i,1))
si code <0 Alors code = code + 65536
Si code>255 Alors
geturlencodel=geturlencodel&"%"&Gauche(Hex(Code),2)&"%"&Droite(Hex(Code),2)
autre
geturlencodel=geturlencodel&mid(Url,i,1)
finir si
suivant
fonction de fin
fonction getHTTPage(url)
en cas d'erreur, reprendre ensuite
atténué http
définir http=Serveur.createobject("Msxml2.XMLHTTP")
Http.open "GET",url,false
Http.envoyer()
si Http.readystate＜＞4 alors quittez la fonction
getHTTPPage=bytes2BSTR(Http.responseBody)
définir http = rien
si err.number＜＞0 alors err.Clear
fonction de fin
Fonction octets2BSTR(vIn)
dim strRetour
dim je,ThisCharCode,NextCharCode
strRetour = ""
Pour i = 1 À LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Si ThisCharCode < &H80 Alors
strReturn = strReturn & Chr(ThisCharCode)
Autre
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
je = je + 1
Fin si
Suivant
octets2BSTR = strReturn
de fin de fonction
getFileName (nom de fichier byval)
si instr(nom de fichier,"/")>0 alors
fileExt_a=split(nom de fichier,"/")
getFileName=lcase(fileExt_a(ubound(fileExt_a)))
si instr(getFileName,"?")>0 alors
getFileName=gauche(getFileName,instr(getFileName,"?")-1)
finir si
autre
getFileName=nom du fichier
finir si
fonction de fin
fonction getHTTPstr(url)
en cas d'erreur, reprendre ensuite
atténué http
définir http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.envoyer()
si Http.readystate＜＞4 alors quittez la fonction
getHTTPstr=Http.responseBody
définir http = rien
si err.number＜＞0 alors err.Clear
fonction de fin
Function CreateDIR(ByVal LocalPath) 'Programme pour créer un répertoire S'il existe plusieurs niveaux de répertoires, créez-les un par un en cas d'erreur, reprenez ensuite.
LocalPath = Remplacer (LocalPath, "", "/")
Définir FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split (CheminLocal, "/")
path_level = UBound(patharr)
Pour I = 0 Vers path_level
Si I = 0 Alors pathtmp = patharr(0) & "/" Sinon pathtmp = pathtmp & patharr(I) & "/"
cpath = Gauche(chemintmp, Len(chemintmp) - 1)
Si ce n'est pas FileObject.FolderExists (cpath), alors FileObject.CreateFolder cpath
Suivant
Définir FileObject = Rien
Si Numéro d'erreur ＜＞ 0 Alors
CréerDIR = Faux
Err.Effacer
Autre
CréerDIR = Vrai
Fin si
de fin de fonction
GetfileExt (nom de fichier byval)
fileExt_a=split(nom de fichier,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
fonction de fin
fonction getvirtual(str,path,urlhead)
si left(str,7)="http://" alors
URL = chaîne
sinon si left(str,1)="/" alors
start=instrRev(str,"/")
si début = 1 alors
URL="/"
autre
url=gauche(str,début)
finir si
url=urlhead&url
sinon si left(str,3)="../" alors
str1=mid(str,inStrRev(str,"../")+2)
ar=split(str,"../")
lv=ubound(ar)+1
ar=split(chemin,"/")
URL="/"
pour i=1 à (ubound(ar)-lv)
url=url&ar(i)
suivant
URL=url&str1
url=urlhead&url
autre
url=urlhead&str
finir si
getvirtual=url
fonction de fin
'Exemple de code
faible dlpath
virtuel="/downweb/"
truepath=server.MapPath (virtuel)
si requête("url")＜＞ "" alors
url=requête("url")
fn=getFileName(url)
urlhead=gauche(url,(instr(replace(url,"//",""),"/")+1))
urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
strContent = getHTTPPage(url)
mystr=strContenu
Définir objRegExp = Nouvelle expression rationnelle
objRegExp.IgnoreCase = True
objRegExp.Global = Vrai
objRegExp.Pattern = "(src|href)=.[^＞]+? "
Définir les correspondances =objRegExp.Execute(strContent)
Pour chaque match dans les matchs
str=Match.Valeur
str=remplacer(str,"src=","")
str=remplacer(str,"href=","")
str=remplacer(str,"""","")
str=remplacer(str,"'","")
nom de fichier = GetfileName (str)
getRet=getVirtual(str,urlpath,urlhead)
temp=Remplacer(getRet,"//","**")
start=instr(temp,"/")
endt=instrRev(temp,"/")-start+1
si début>0 alors
repl=virtuel&mid(temp,start)&" "
'réponse.Écrire une réponse&"＜br＞"
mystr=Remplacer(mystr,str,repl)
dir=mid(temp,start,endt)
temp=truepath&Replace(dir,"/","")
CréerDir(temp)
'response.Write getRet&"||"&temp&filename&"＜br＞＜br＞"
SaveToFile getRet, temp et nom de fichier
finir si
Suivant
définir des correspondances = rien
terminer si
%>