ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文
Windowsで、メモ帳さえあればできる画像一括ダウンロードスクリプト ( No.0 )
日時: 2009/06/19 00:00
名前: lightbox



拡張子:
Set objSrvHTTP = Wscript.CreateObject("MSXML2.XMLHTTP") 
Set Stream = Wscript.CreateObject("ADODB.Stream") 
Set IEDocument = Wscript.CreateObject( "InternetExplorer.Application" ) 
Set Fso = CreateObject( "Scripting.FileSystemObject" ) 
 
strCurPath = WScript.ScriptFullName 
Set obj = Fso.GetFile( strCurPath ) 
Set obj = obj.ParentFolder 
strCurPath = obj.Path 
 
strUrl = "画像のサムネイトルの一覧のあるページのURL"
Wscript.Echo strUrl & " からダウンロードしています" 
 
on error resume next 
Call objSrvHTTP.Open("GET", strUrl, False ) 
if Err.Number <> 0 then 
	Wscript.Echo Err.Description 
	Wscript.Quit 
end if 
on error goto 0 
 
objSrvHTTP.Send 
 
Stream.Open 
Stream.Type = 1	' バイナリ 
Stream.Write objSrvHTTP.responseBody 
Stream.SaveToFile strCurPath & "\_work.htm", 2 
Stream.Close 
 
IEDocument.Visible = True 
IEDocument.Navigate( strCurPath & "\_work.htm" ) 
 
Do While IEDocument.Busy 
	Wscript.Sleep 100 
Loop 
 
Dim aImage,strImage 
strImage = "" 

' IMG 要素の一覧( サムネイトル ) 欲しい画像の URL を作成して
' リストとして作成する
For Each obj In IEDocument.document.getElementsByTagName("IMG") 
	if InStr( obj.src & "", ".png_S" ) <> 0 and obj.className = "" then 
		target = Replace( obj.src & "", ".png_S.jpg", ".png" ) 
		if strImage <> "" then 
			strImage = strImage & "," 
		end if 
		strImage = strImage & target 
	End if 
Next 
 
aImage = Split(strImage,",") 
IEDocument.Quit 
 
MsgBox("ダウンロードを開始します") 

' 配列から一括ダウンロード
For Each data In aImage 

	aData = Split( data, "/" ) 
	localName = aData( Ubound(aData) ) 

	on error resume next 
	Call objSrvHTTP.Open("GET", data, False ) 
	if Err.Number <> 0 then 
		Wscript.Echo Err.Description 
		Wscript.Quit 
	end if 
	on error goto 0 

	objSrvHTTP.Send 

	Stream.Open 
	Stream.Type = 1	' バイナリ 
	Stream.Write objSrvHTTP.responseBody 
	Stream.SaveToFile strCurPath & "\" & localName, 2 
	Stream.Close 

	Wscript.Echo localName & " をダウンロードしました" 

	' いちおう少し一休み
	Wscript.Sleep 10 
 
Next