Web ページからの画像のダウンロードに関する記事を読みましたが、Web ページ内のすべての接続リソースをダウンロードし、Web ページ内のディレクトリ構造に従ってローカル ディレクトリを作成できるようになりました。リソースを保存します。
download.asp?url=ダウンロードする Web ページ
の download.asp コードは
次のとおりです:<%
Server.ScriptTimeout=9999
関数 SaveToFile(from,tofile)
エラー時は次から再開
dim geturl、objStream、imgs
geturl=トリム(から)
Mybyval=getHTTPstr(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write Mybyval
objstream.SaveToFile tofile,2
objstream.Close()
objstream = なしを設定します
if err.number＜＞0 then err.Clear
end function
function geturlencodel(byval url)'中国語ファイル名変換
ディムアイ、コード
geturlencodel=""
トリム(URL)=""の場合、関数を終了します
for i=1 から len(URL)
コード=Asc(mid(URL,i,1))
コード＜0の場合 コード = コード + 65536
コード＞255の場合
geturlencodel=geturlencodel&"%"&Left(Hex(コード),2)&"%"&Right(Hex(コード),2)
それ以外
geturlencodel=geturlencodel&mid(URL,i,1)
終了する場合
次
終了関数
関数 getHTTPage(url)
エラー時は次から再開
薄暗いhttp
set http=Server.createobject("Msxml2.XMLHTTP")
http.open "GET",url,false
Http.send()
if Http.readystate＜＞4 then exit 関数
getHTTPPage=bytes2BSTR(Http.responseBody)
http=何も設定しない
if err.number＜＞0 then err.Clear
関数の終了
関数 bytes2BSTR(vIn)
dim strReturn
dim i、ThisCharCode、NextCharCode
strReturn = ""
For i = 1 から LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 then
strReturn = strReturn & Chr(ThisCharCode)
それ以外
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
終了の場合
次
bytes2BSTR = strReturn
関数の終了
function getFileName(byval filename)
if instr(filename,"/")>0 then
fileExt_a=split(ファイル名,"/")
getFileName=lcase(fileExt_a(ubound(fileExt_a)))
if instr(getFileName,"?")>0 then
getFileName=left(getFileName,instr(getFileName,"?")-1)
終了する場合
それ以外
getFileName=ファイル名
終了する場合
終了関数
function getHTTPstr(url)
エラー時は次から再開
薄暗いhttp
set http=server.createobject("MSXML2.XMLHTTP")
http.open "GET",url,false
Http.send()
if Http.readystate＜＞4 then exit 関数
getHTTPstr=Http.responseBody
http=何も設定しない
if err.number＜＞0 then err.Clear
終了関数
Function CreateDIR(ByVal LocalPath) ' ディレクトリを作成するプログラム。複数のレベルのディレクトリがある場合は、1 つずつ作成します。
LocalPath = Replace(LocalPath, "", "/")
Set 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 = なしを設定します
If Err.Number ＜＞ 0 then
CreateDIR = False
エラークリア
それ以外
CreateDIR = True
終了の場合
終了関数
function GetfileExt(byval ファイル名)
fileExt_a=split(ファイル名,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
関数の終了
function getvirtual(str,path,urlhead)
left(str,7)="http://" の場合
URL=文字列
elseif left(str,1)="/" then
start=instrRev(str,"/")
開始=1の場合
URL="/"
それ以外
url=left(str,start)
終了する場合
URL=URLヘッド&URL
elseif left(str,3)="../" then
str1=mid(str,inStrRev(str,"../")+2)
ar=split(str,"../")
lv=ubound(ar)+1
ar=split(パス,"/")
URL="/"
for i=1 から (ubound(ar)-lv)
URL=URL&AR(i)
次
URL=URL&str1
URL=URLヘッド&URL
それ以外
URL=urlhead&str
終了する場合
getvirtual=url
終了関数
'コード例
dim dlpath
virtual="/downweb/"
truepath=サーバー.マップパス(仮想)
if request("url")＜＞ "" then
URL=リクエスト("URL")
fn=getファイル名(url)
urlhead=left(url,(instr(replace(url,"//",""),"/")+1))
urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
strContent = getHTTPPage(url)
mystr=strContent
objRegExp = 新しい正規表現を設定します
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "(src|href)=.[^＞]+? "
一致を設定 =objRegExp.Execute(strContent)
試合中の各試合について
str=一致値
str=replace(str,"src=","")
str=replace(str,"href=","")
str=replace(str,"""","")
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.Write repl&"＜br＞"
mystr=Replace(mystr,str,repl)
dir=mid(temp,start,endt)
temp=truepath&Replace(dir,"/","")
CreateDir(一時)
'response.Write getRet&"||"&temp&filename&"＜br＞＜br＞"
SaveToFile getRet,temp&ファイル名
終了する場合
次
一致=なしを設定します
%>
の場合は終了