自動巡回について

お世話になります。

気象庁の天気図等を自動巡回でダウンロードを考えています。
同じURLの中に、リストで選んで（時間など）画像を表示させるものがあるのですが、
こういったものも自動巡回ソフトで取り込むことはできるのでしょうか？
どなたか、どうぞご教授下さい。

No.1 回答者： KanjistX 回答日時： 2006/07/06 20:46

天気図などの画像ファイルのURLの名前が規則的ならば（気象庁の天気図とか）画像ファイルを自動巡回で直接ダウンロードしてしまえばよいので技術的には容易ですが、各サイトの利用規約に従うようにご注意ください。

気象庁のＨＰの利用上の注意には「当ホームページは、通常のブラウザで閲覧することを前提に各種情報を掲載しております。自動巡回ソフト等による、定期的、自動的な気象データの収集等は、サーバーに負荷がかかる等の理由から、原則としてご遠慮いただいております。ご理解お願いします。」と書いてあります。

参考URL：http://www.kishou.go.jp/info/coment.html#exclusion

この回答への補足

早速のお返事ありがとうございます。
利用規約には従っています。常時取り込むわけではありません。

ところで可能ということですが、
例えば
http://www.jma.go.jp/jp/radame/index.html?areaCo …
の中で、時間を変えた数枚を取り込みたいのですが
できるのでしょうか？

補足日時：2006/07/06 21:09

No.2 回答者： KanjistX 回答日時： 2006/07/07 09:12

ちょうどよい巡回ソフトが見つからなかったので（よく探せばあるかもしれませんが）、参考URLのスクリプトを利用して、

http://www.jma.go.jp/jp/radame/index.html?areaCo …
の12時間前から現在時までの12枚の画像を一挙に取得するスクリプトを作ってみました。
（セキュリティ等については一切責任を負いません）

Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

For i=-12 To 0 '12時間前から現在時まで
dYear = Fmt(Year(DateAdd("h",i,Now)),4)
dMonth = Fmt(Month(DateAdd("h",i,Now)),2)
dDay = Fmt(Day(DateAdd("h",i,Now)),2)
dHour = Fmt(Hour(DateAdd("h",i,Now)),2)
dMinute = "00"
dName = dYear & dMonth & dDay & dHour & dMinute & "-00.png"
sSource = "http://www.jma.go.jp/jp/radame/imgs/prec/000/" & dName 'ダウンロード元
sDest = dName 'コピー先
Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
oHTTP.Open "GET", sSource, False
oHTTP.Send
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.Write oHTTP.responseBody
Stream.Savetofile sDest, adSaveCreateOverWrite
Next

Function Fmt(num, digit) '0を頭につけて桁数を合わせる（例：6→06）
Fmt = Right(String(digit, "0") & num, digit)
End Function

↑をメモ帳などにコピー＆ペーストしてtest.vbsとでも名前をつけてデスクトップに保存して実行すれば画像取得ができるのが確認できると思います。
dMinute = "00"のところを
dMinute = "30"にすれば○時30分の天気図も取り込めます。

天気図の画像ファイル名が
200607070400-00.png
200607070300-00.png
200607070200-00.png
200607070100-00.png
200607070000-00.png
200607062300-00.png
200607062200-00.png
・・・
と連番になっているので指定ファイル名を規則的に変化させて保存処理させているだけです。
たぶんこのくらい可能な自動巡回ソフトは普通にあります。
できるかどうかということでしたので、例を挙げてみました。

参考URL：http://winscript.s41.xrea.com/wiki/index.php?%5B …

この回答への補足

おーっ、できました。
すごいですね。ありがとうございます。m(_ _)m

このリンク先の予報6時間分が欲しかったので、
数値を少しいじればいいのでしょうか？
やってみます。

ところで、自動巡回には「巡集」というのを使っています。
これでは、できなそうです。
こういうことができるソフトもあるかもしれませんね。

補足日時：2006/07/07 12:40

この回答へのお礼

分からない．．．

エクセルVBAの手直し程度の知識しか持ち合わせいません。
現在時刻から、６時間後までの予報の画像が欲しいのですが、
どう修正すればいいのでしょうか？
ファイル名の後2文字を01から06にするようですが。

申し訳ありませんが、今一度ご教授頂けないでしょうか？

お礼日時：2006/07/07 14:26

No.3 回答者： KanjistX 回答日時： 2006/07/07 14:57

あー、予報のほうでしたか。

どっちかなぁと思いつつ予報でないほうで組んでしまいました。
予報天気図は
200607071300-00.png
200607071300-01.png
200607071300-02.png
200607071300-03.png
200607071300-04.png
200607071300-05.png
200607071300-06.png
（-00.pngは予報でないですが）となってますので、Forの繰り返しでdNameの"-00.png"で固定してるところを自由に動かせるようにしましょう。
dYearとかdMonthはdYear=2006とかにしてその都度変更する方がわかりやすいし便利かもしれません。


・・・と、がんばっていただいてもいいのですが、GetJpgという便利なフリーウェアを見つけてしまったのでご紹介しておきます。
http://www.vector.co.jp/soft/win95/net/se265138. …

使い方はReadmeをお読みになればおわかりになるかと思いますが、GetJpg.exeを起動して
URLの設定を
Baseにhttp://www.jma.go.jp/jp/radame/imgs/prec/000/200 …
1stに
00-
2ndに
.png
として、連番の設定を
1stは
Number
Start 12 End 14
Format 0#
2ndは
Start 0 End 6
Format 0#
としてやれば、12時から14時の6時間予報を全取得できます（合計３×７＝２１枚）。
設定の仕方によって様々な連番ファイルが取得可能です。

GetJpgを探し当てて思い出しましたが、以前このソフト使ったことありました。紹介遅れてすみません。
まぁスクリプトも何かと便利なんで覚えておくに越したことはありませんが。

参考URL：http://www.vector.co.jp/soft/win95/net/se265138. …

No.4 回答者： KanjistX 回答日時： 2006/07/07 15:07

No.3を書き込んだ後でNo.2への回答へのお礼を見ました。

今後のためにも予報図のためのスクリプト例も載せておきます。
何時の予報をとってくるかはスクリプト内で指定するようにしました。
下のスクリプトは2006年7月7日13時00分の6時間予報を取得するものです。

Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

For i=0 To 6 '現在時から6時間後まで
dYear = "2006"
dMonth = "07"
dDay = "07"
dHour = "13"
dMinute = "00"
dName = dYear & dMonth & dDay & dHour & dMinute & "-0" & i & ".png"
sSource = "http://www.jma.go.jp/jp/radame/imgs/prec/000/" & dName 'ダウンロード元
sDest = dName 'コピー先
Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
oHTTP.Open "GET", sSource, False
oHTTP.Send
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.Write oHTTP.responseBody
Stream.Savetofile sDest, adSaveCreateOverWrite
Next

この回答への補足

ほんとに、ありがとうございます。
これを使うのは、早朝、気象当番の時、いろいろな情報を集めなければいけなくて、
こういうのがあると精神的に本当に楽になります。
重ねて、お礼申し上げます。

ただ、「test.vbs」をクリックすれば、
いつも最新の時間から6時間後までが入手できるようにしておきたく、
以下のようにコピペで変えましたがうまくいきません。

Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

For i= 0 To 6 '現在時刻から6現在後まで
dYear = Fmt(Year(DateAdd("h",i,Now)),4)
dMonth = Fmt(Month(DateAdd("h",i,Now)),2)
dDay = Fmt(Day(DateAdd("h",i,Now)),2)
dHour = Fmt(Hour(DateAdd("h",i,Now)),2)
dMinute = "00"
dName = dYear & dMonth & dDay & dHour & dMinute & "-0" & i & ".png"
sSource = "http://www.jma.go.jp/jp/radame/imgs/prec/000/" & dName 'ダウンロード元
sDest = dName 'コピー先
Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
oHTTP.Open "GET", sSource, False
oHTTP.Send
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.Write oHTTP.responseBody
Stream.Savetofile sDest, adSaveCreateOverWrite
Next

Function Fmt(num, digit) '0を頭につけて桁数を合わせる（例：6→06）
Fmt = Right(String(digit, "0") & num, digit)
End Function

dHour = Fmt(Hour(DateAdd("h",i,Now)),2)
のところが１づつ増えてしまいます。
iに問題がありそうですが、いじってみてもできません。
今一度、ご教授頂けないでしょうか。。

補足日時：2006/07/09 11:08

この回答へのお礼

なんとか、できてしまいました。

Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

For i= 0 To 6 '現在時刻から6現在後まで
dYear = Fmt(Year(Now),4)
dMonth = Fmt(Month(Now),2)
dDay = Fmt(Day(Now),2)
dHour = Fmt(Hour(Now),2)
dMinute = "00"
dName = dYear & dMonth & dDay & dHour & dMinute & "-0" & i & ".png"
sSource = "http://www.jma.go.jp/jp/radame/imgs/prec/000/" & dName 'ダウンロード元
sDest = dName 'コピー先
Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
oHTTP.Open "GET", sSource, False
oHTTP.Send
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.Write oHTTP.responseBody
Stream.Savetofile sDest, adSaveCreateOverWrite
Next

Function Fmt(num, digit) '0を頭につけて桁数を合わせる（例：6→06）
Fmt = Right(String(digit, "0") & num, digit)
End Function

ですよね。
ほとんど意味分かりませんが．．．
ありがとうございました。　m(_ _)m

最後にファイルの保存先ですが
この「test.vbs」をどこに置いておいても
ダウンロードしたファイルがデスクトップに保存させるには、
どういった文を追加すればよいのでしょう。
対価もなく、ずうずうしくて、ほんと申し訳ありません。

ありがとうございました。

お礼日時：2006/07/09 16:14

No.5 ベストアンサー 回答者： KanjistX 回答日時： 2006/07/09 18:33

＞ほとんど意味分かりませんが．．．

いやいや、拝見しててだんだん理解されてるのが伺えましたよ。

デスクトップの指定については
Set ws = WScript.CreateObject("WScript.Shell") '特殊フォルダ名の取得
desktopDir = ws.SpecialFolders("Desktop") 'デスクトップの実体
の二行で、誰のパソコンで作動させても自動的にデスクトップを指定してくれるようになります。

スクリプト全体を載せておきます。

Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

For i= 0 To 6 '現在時刻から6時間後まで
dYear = Fmt(Year(Now),4)
dMonth = Fmt(Month(Now),2)
dDay = Fmt(Day(Now),2)
dHour = Fmt(Hour(Now),2)
dMinute = "00"
dName = dYear & dMonth & dDay & dHour & dMinute & "-0" & i & ".png"
sSource = "http://www.jma.go.jp/jp/radame/imgs/prec/000/" & dName 'ダウンロード元
Set ws = WScript.CreateObject("WScript.Shell") '特殊フォルダ名の取得
desktopDir = ws.SpecialFolders("Desktop") 'デスクトップの実体
sDest = desktopDir & "\" & dName 'コピー先
Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
oHTTP.Open "GET", sSource, False
oHTTP.Send
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.Write oHTTP.responseBody
Stream.Savetofile sDest, adSaveCreateOverWrite
Next

Function Fmt(num, digit) '0を頭につけて桁数を合わせる（例：6→06）
Fmt = Right(String(digit, "0") & num, digit)
End Function

対価なんてとんでもありません。
後々自分が同じような問題に直面したときにここでの質問＆回答が役に立ちますし。
属性書いてますが、私は経験者ではありませんので。
気象当番がんばってください。

この回答へのお礼

本当にありがとうございました。
こういったことが、さらりとできるなんてすごいです。
私のパソコン作業なんて、非効率的なことばかりなんでしょうね．．．。
プログラムのこと、簡単な入門書でも買ってみようかな、なんて、
無謀なことを、ちらっと思ったりしてしまいました。

ありがとうございました。m(_ _)m

お礼日時：2006/07/10 00:06