'=====================================================================
Option Explicit
'On Error Resume Next

Dim objFSO      ' FileSystemObject
Dim objFile     ' ファイル読み込み用
Dim Err
Dim objArgs
Dim I
Dim l, s, e, fname, line, url, wareki, date, m, d

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'If Err.Number = 0 Then

'WScript.Echo objFSO.GetFileVersion("C:\WINNT\system32\cscript.exe") 

	Dim objWshShell     ' WshShell オブジェクト
	Set objWshShell = WScript.CreateObject("WScript.Shell")
	'WScript.Echo "現在のフォルダは " & objWshShell.CurrentDirectory & " です。"

	Set objArgs = WScript.Arguments
	For I = 0 to objArgs.Count - 1
		WScript.Echo objArgs(I)

		Set objFile = objFSO.OpenTextFile(objArgs(I))

Do Until objFile.AtEndOfStream
	l = objFile.ReadLine
	s = InStr(l, "value=削除")
	If s <> 0 then
		Exit Do	'有効な「value=」を探す為、「value=削除」を探して、以降の行から、改めて検索開始する
	End If
Loop


line = 1
Do Until objFile.AtEndOfStream
	l = objFile.ReadLine
	s = InStr(l, "value=")
	If s <> 0 then
		e = InStr(l, " name=")

		If e <> 0 then
			fname = Mid(l, s+6, e - 6 - s)
		Else
			fname = Mid(l, s+6)
		End If

		If Left(fname, 1) = chr(34) And Right(fname, 1) = chr(34) then
'			WScript.Echo "double quoted chr(34) !"
			fname = Mid(fname, 2, Len(fname) - 2)
		End If


		'url
		Do Until objFile.AtEndOfStream
		l = objFile.ReadLine
		s = InStr(l, "href=")
		If s <> 0 then
			e = InStr(l, ">")

			If e <> 0 then
				url = Mid(l, s+6, e - 7 - s)
			Else
				url = Mid(l, s+6)
			End If
			Exit Do
		End If
		Loop

		Do Until objFile.AtEndOfStream
		l = objFile.ReadLine
		s = InStr(l, "")
		If s <> 0 then
			l = objFile.ReadLine
			s = InStr(l, "")
			If s <> 0 then
				l = objFile.ReadLine
				s = InStr(l, "")
				If s <> 0 then
					e = InStr(l, "")
					If e <> 0 then
						wareki = Mid(l, s+39, e - (s+39))
						m = InStr(wareki, "月")
					 	d = InStr(wareki, "日")
						date = Left(wareki, 4) & "/" & Mid(wareki, 6, m-6) & "/" & Mid(wareki, m+1, d-m-1) & " 00:00:00"
						Exit Do
					End If
				End If
			End If
		End If
		Loop

'url = "http://proxy.f3.ymdb.yahoofs.jp/bc/2bd275ac/bc/bookmark(examu).htm?bccx_gJBLWEQ_UG_"
'		WScript.Echo fname & "(" & line & ")" & url
'url = "http://www.sio.no-ip.com/mt/shio/DSC_0188.jpg"
'		WScript.Echo fname & "(" & date & ")" & wareki
'		call changeFileDate(objWshShell.CurrentDirectory, "test.txt", "2008/12/1 00:00:00")
		WScript.Echo fname & "(" & line & ")" & date
'		WScript.Echo fname

		call getHTTPasync(url, fname)	'ダウンロード実行！
		call changeFileDate(objWshShell.CurrentDirectory, fname, date)

		line = line + 1
'		WScript.Echo l & "e=" & e
'		fname = Mid(l, s, e - s)
'		WScript.Echo l & "fname=" & fname
	End If
Loop



'		If Err.Number = 0 Then
'			WScript.Echo objFile.ReadAll
'			WScript.Echo objFile.ReadLine
			objFile.Close
'		Else
'			WScript.Echo "ファイルオープンエラー: " & Err.Description
'		End If

	Next

'Else
'WScript.Echo "エラー: " & Err.Description
'End If

Set objFile = Nothing
Set objFSO = Nothing
Set objWshShell = Nothing

'call getHTTPasync("http://www.sio.no-ip.com/mt/shio/DSC_0188.jpg")

'==========================================================================
Sub changeFileDate(strFolderName, strFileName, dtmModifyDate)
'Dim strFolderName   ' フォルダ名
'Dim strFileName     ' ファイル名
'Dim dtmModifyDate   ' 更新日付
Dim objShell        ' Shell オブジェクト
Dim objFolder       ' フォルダ情報
Dim objFile         ' ファイル情報

'strFolderName = "C:\Temp"
'strFileName = "Test.txt"
'dtmModifyDate = CDate("2005/10/25 12:34:56")

	Set objShell = WScript.CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace(strFolderName)
    Set objFile = objFolder.ParseName(strFileName)

	objFile.ModifyDate = dtmModifyDate
'	WScript.Echo strFolderName & "\" & strFileName & " の更新日付を " & dtmModifyDate & " に変更しました。"

Set objFile = Nothing
Set objFolder = Nothing
Set objShell = Nothing
End Sub

'==========================================================================
Sub getHTTPasync(strURL, strFname)
	on error resume next
	Dim objweb
'	Dim arwork
	Dim objADO
	Dim ret,res

'WScript.Echo "getHTTPasync(" & strURL & ", " & strFname & ")"
WScript.Echo "●ダウンロード（" & strFname & "）"

'	arwork = split(strURL,"/")
'	If Len(filename) = 0 Then
'		strFname = Replace(Wscript.ScriptFullName,Wscript.ScriptName,"") & arwork(Ubound(arwork))
'	Else
'		strFname = filename
'	End If

	err.clear
	Set objweb = CreateObject("MSXML2.ServerXMLHTTP.6.0")

	'MSXML環境依存なるべく排除
	if err.number <> 0 then
		err.clear
		Set objweb = CreateObject("MSXML2.ServerXMLHTTP")
	end if
	if err.number <> 0 then
		err.clear
		Set objweb = CreateObject("MSXML2.XMLHTTP")
	end if
	
	if err.number = 0 then
		'objweb.Open "GET",strURL,False,"ユーザーID", "パスワード"
		objweb.Open "GET", strURL, False
		objweb.Send
		res = objweb.responseBody
		
		set objADO = CreateObject("ADODB.Stream")
		objADO.Type = 1 'BINARY
		objADO.Open()
		objADO.Write(res)
		objADO.SaveToFile strFname,2 ' SAVE CREATE OVERWRITE
		objADO.Close
'WScript.Echo "make(" & strFname & ")"
'wscript.echo "　　　　接続ステータス : " & objweb.Status & " (" & objweb.statusText & ")" & vbCrLf & strFname & " に保存しました"
		wscript.echo "　　　　接続ステータス : " & objweb.Status & " (" & objweb.statusText & ") 保存に成功しました！"
		Set objADO = Nothing
		Set objweb = Nothing
	else ' err
		wscript.echo "CreateObject失敗."
	end if
 End Sub