|
国立国会図書館の近代デジタルライブラリーの画像をJPEG形式で自働的にダウンロードする方法。
ダウンローダー等を使用しての方法は、不正アクセスとの批判も受けそうなので、インターネットエクスプローラーをVBScriptで、自動巡回して、画像を保存していく方法を紹介してゆきたい。
規定の方法だと、PDF形式でしか、落とせないので、何かと不便だ。しかも、１０ページ単位でしかダウンロードできないので、公卿補任や尊卑分脈などの大量の書籍を保存するには、面倒極まりないが、ウィンドウズ付属のメモ帳を使って、VBScriptのプログラムを組めば、自動的に落とせる。
手順
①ウィンドウズのメモ帳を起動する。
②下記の点線で囲まれたプログラムソース部分をコピーして、メモ帳に貼り付ける。
③インターネットに接続して、国立国会図書館近代デジタルライブラリーから目的の書籍の
「本文を見る」をクリックする。
④本文の新しいブラウザが開いたら、上部の青色の部分より下の背景が白色部分
（このページはフレームページとなっているので・・）の画像やボタン以外の任意の余白上で
マウスを右クリックして、ポップアップメニューよりソースの表示をクリックする。
⑤メモ帳で表示されたソース中から”大サイズ画面”と書かれた部分を探す。
⑥”大サイズ画面”という文字列の直前のoptionタグで指定されているjgmWeb?～から始まる
urlをコピーする。（中サイズ画面や小サイズ画面を保存したい場合は、
同様に直前のoptionタグで指定されているurl）
⑦貼り付けてあるプログラムの１２行目のSRCURL = の後のダブルクォーテーション内の
サンプルurlをコピーしたurlに張り替える。
⑧プログラムの初期設定内のfpage=の値を保存したい画像の最初のページに書き換える。
⑨同様に、epageに最後のページ数を指定する。
⑩初期設定内fNameに保存したいフォルダ名を指定する（※本プログラムは、
エラー対策など考慮していないので、必ず存在するフォルダを指定する。
また、フォルダ名の最後は必ず\を付ける）。
⑪初期設定内fNameFにファイル名を指定する（指定したファイル名+連番+.jpgという形式で
保存される。省略可能だが、同一フォルダ内に同名のファイルがあるかは、
チェックしていないので、既に同名のファイルがある場合は上書きされてしまう
（警告のメッセージウィンドウは出ない）ので、要注意）。
⑫拡張子を.vbsとして（ファイル名指定の下のファイルの種類は、「すべてのファイル」を
選択しておく）、任意の名前で保存する。
⑬保存したファイルをダブルクリックするなどして、プログラムを起動する。
新しいブラウザが起動して、自動的に指定したページへ移動してゆく。urlを取得する為に表示したブラウザは、閉じてもかまわないが、プログラムから起動されたブラウザを閉じると、エラーを起こすので、注意。その外、回線切断・画像ページが正常に表示されない等のエラーが発生しても、ブラウザを閉じただけでは、プログラムは終了されない（プログラムを途中で中断する機能を設計していない。また、高速回線でない場合には、ページ数が多いと、数十時間もかかるので、計画的にダウンロードしてもらいたい）ので、必ずウィンドウズを再起動して欲しい。
正常に終了すれば、"end"のメッセージボックスが表示されて、プログラムは終了する。
' **********************************************
' 公卿類別譜
' **********************************************
On Error Resume Next
public sSource,fcnt,stkk,fpage,epage,i,fName,fNameF
public lk,lk2,iul,lk3,lk4,lk5,SRCURL
Dim objIE ' IE オブジェクト
' 初期設定 ---------------------
SRCURL = "jgmWeb?%DispNdl1%si=0&rvl=0&rno=0&sz=2&ln=0&tl=0&l=4&cp=1&cy=0&cx=0&i=30
\40008530\00000\0001.jp2"
fpage=1 '最初のページを指定。
epage=3 '最後のページを指定。
fName = "c:\" '保存先フォルダを指定。
fNameF = "test" '保存する画像ファイル名
' ----------------------------------
Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Set oHTTP = WScript.CreateObject("Microsoft.XMLHTTP")
Set objIE = WScript.CreateObject("InternetExplorer.Application")
'インターネットエクスプローラを表示
objIE.Visible = True
lk2="http://kindai.ndl.go.jp/scrpt/"
lk3=left(SRCURL,instr(SRCURL,"cp=")+2)
lk4=mid(SRCURL,instr(SRCURL,"&cy="),instrrev(SRCURL,"\")-instr(SRCURL,"&cy=")+1)
lk5=right(SRCURL,len(SRCURL)-instrrev(SRCURL,".")+1)
for i=fpage to epage
stkk=Right("0000" & i,4)
lk=lk2 & lk3 & stkk & lk4 & stkk & lk5
objIE.Navigate lk
' ページが取り込まれるまで待つ
Do While objIE.busy
WScript.Sleep(100)
Loop
Do While objIE.Document.readyState <> "complete"
WScript.Sleep(100)
Loop
fcnt=i
sSource =objIE.Document.images(12).src
call gazo
next
msgbox("end")
Sub gazo()
oHTTP.Open "GET", sSource, False
oHTTP.Send
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.Write oHTTP.responseBody
Stream.Savetofile fName & fNameF & fcnt & ".jpg", adSaveCreateOverWrite
Stream =nothing
end sub
|
|
←バナーをクリックするとダウンロード・ページへ移動します。
