Ich habe einen Artikel über das Herunterladen von Bildern von Webseiten gelesen. Ich habe einige Verbesserungen vorgenommen. Es kann alle Verbindungsressourcen auf der Webseite herunterladen und ein lokales Verzeichnis entsprechend der Verzeichnisstruktur erstellen um die Ressourcen zu speichern.
download.asp?url=Der download.asp-Code der
Webseite, die Sie herunterladen möchten,
lautet wie folgt:<%
Server.ScriptTimeout=9999
Funktion SaveToFile(from,tofile)
Bei Fehler als nächstes fortfahren
dim geturl,objStream,imgs
geturl=trimmen(von)
Mybyval=getHTTPstr(geturl)
Setze objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write Mybyval
objstream.SaveToFile tofile,2
objstream.Close()
setze objstream=nichts
Wenn err.number<>0, dann err.Clear
Endfunktion
Funktion geturlencodel(byval url)'Konvertierung chinesischer Dateinamen
Dim i,code
geturlencodel=""
Wenn trim(Url)="", dann beenden Sie die Funktion
für i=1 bis len(URL)
code=Asc(mid(Url,i,1))
Wenn Code <0, dann ist Code = Code + 65536
Wenn Code > 255, dann
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
anders
geturlencodel=geturlencodel&mid(Url,i,1)
Ende wenn
nächste
Endfunktion
Funktion getHTTPage(url)
Bei Fehler als nächstes fortfahren
dimmen Sie http
set http=Server.createobject("Msxml2.XMLHTTP")
Http.open „GET“,url,false
Http.send()
Wenn Http.readystate＜>4, dann beenden Sie die Funktion
getHTTPPage=bytes2BSTR(Http.responseBody)
setze http=nichts
Wenn err.number<>0, dann err.Clear
Endfunktion
Funktion bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
Für i = 1 Zu LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Wenn ThisCharCode < &H80 Dann
strReturn = strReturn & Chr(ThisCharCode)
Anders
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
ich = ich + 1
Ende wenn
Nächste
bytes2BSTR = strReturn
Endfunktion
function getFileName(byval filename)
if instr(filename,"/")>0 dann
fileExt_a=split(filename,"/")
getFileName=lcase(fileExt_a(ubound(fileExt_a)))
if instr(getFileName,"?")>0 dann
getFileName=left(getFileName,instr(getFileName,"?")-1)
Ende wenn
anders
getFileName=Dateiname
Ende wenn
Endfunktion
Funktion getHTTPstr(url)
Bei Fehler als nächstes fortfahren
dimmen Sie http
set http=server.createobject("MSXML2.XMLHTTP")
Http.open „GET“,url,false
Http.send()
Wenn Http.readystate＜>4, dann beenden Sie die Funktion
getHTTPstr=Http.responseBody
setze http=nichts
Wenn err.number<>0, dann err.Clear
Endfunktion
Funktion CreateDIR(ByVal LocalPath) 'Programm zum Erstellen eines Verzeichnisses. Wenn mehrere Verzeichnisebenen vorhanden sind, erstellen Sie diese nacheinander
LocalPath = Ersetzen(LocalPath, „“, „/“)
Setze FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
Für I = 0 bis path_level
Wenn I = 0, dann pathtmp = patharr(0) & "/" Sonst pathtmp = pathtmp & patharr(I) & "/"
cpath = Left(pathtmp, Len(pathtmp) - 1)
Wenn nicht, FileObject.FolderExists(cpath), dann FileObject.CreateFolder cpath
Nächste
Setzen Sie FileObject = Nothing
Wenn Fehlernummer ＜＞ 0, dann
CreateDIR = Falsch
Err.Clear
Anders
CreateDIR = True
Ende wenn
End Function
function GetfileExt(byval filename)
fileExt_a=split(Dateiname,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
Endfunktion
Funktion getvirtual(str,path,urlhead)
if left(str,7)="http://" dann
url=str
elseif left(str,1)="/" then
start=instrRev(str,"/")
wenn start=1 dann
URL="/"
anders
url=left(str,start)
Ende wenn
url=urlhead&url
elseif left(str,3)="../" dann
str1=mid(str,inStrRev(str,"../")+2)
ar=split(str,"../")
lv=ubound(ar)+1
ar=split(path,"/")
URL="/"
für i=1 bis (ubound(ar)-lv)
url=url&ar(i)
nächste
url=url&str1
url=urlhead&url
anders
url=urlhead&str
Ende wenn
getvirtual=URL
Endfunktion
'Beispielcode
dim dlpath
virtual="/downweb/"
truepath=server.MapPath(virtuell)
if request("url")＜＞ "" then
url=request("url")
fn=getFileName(url)
urlhead=left(url,(instr(replace(url,"//",""),"/")+1))
urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
strContent = getHTTPPage(url)
mystr=strContent
Setze objRegExp = Neuer Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "(src|href)=.[^＞]+? "
Übereinstimmungen festlegen =objRegExp.Execute(strContent)
Für jedes Spiel in Spielen
str=Match.Value
str=replace(str,"src=","")
str=replace(str,"href=","")
str=replace(str,"""","")
str=replace(str,"'","")
filename=GetfileName(str)
getRet=getVirtual(str,urlpath,urlhead)
temp=Replace(getRet,"//","**")
start=instr(temp,"/")
endt=instrRev(temp,"/")-start+1
wenn start>0 dann
repl=virtual&mid(temp,start)&" "
'response.Write repl&"＜br＞"
mystr=Replace(mystr,str,repl)
dir=mid(temp,start,endt)
temp=truepath&Replace(dir,"/","")
CreateDir(temp)
'response.Write getRet&"||"&temp&filename&"＜br＞＜br＞"
SaveToFile getRet,temp&filename
Ende wenn
Nächste
set Matches=nothing
Ende, wenn
%>