ワンクリックで当日の番組表を保存するプログラム
解決こちらhttp://tv.biglobe.ne.jp/P27/のテレビ番組表をワンクリックで保存するプログラムをVisual Basicで作りたいのですが、こちらhttp://homepage2.nifty.com/inform/vbmania/source/geturl.htm
のサンプルプログラムを使っても、オフライン(キャッシュも消去)にすると、保存した番組表が表示できません。どのようにすれば、オフラインでも表示できるようになるでしょうか？ また表中の画像を使った記号も保存・表示したいのですが、どのようにすれば良いでしょうか？
えーとつまり、
・ネットに接続されていない環境を作って、
ネット上のリソースを引っ張ってきたい
ということですか？
WEBページ(TV表)を手動で「名前をつけて保存」したものと同じ形に、ＶＢでやりたいということです。
そのTV表は他のWEBページと形式が違うのでしょうか？ 文字化けしてしまいます。
> 「名前をつけて保存」したものと同じ形に、ＶＢでやりたいということです。
うーん…
家のWinXP(Home)では「名前をつけて保存」をすると、
IEさんがHTMLを解析して、必要なリソースを下層フォルダに突っ込んで、さらにHTMLも改造して保存してくれました。
これと同じことをするには、やっぱり自力でHTMLの改造＆リソースの抽出＆HTMLの改造などをしなくてはならないかと思います。
XHTMLとか使えばできるのかな。
http://tv.biglobe.ne.jp/20051111/P27/tv_hyou_2900.html
この番組表のソースを見ても、番組名などの文字情報が見あたりません。HTMLはそこそこホームページが作れるくらい理解していますが、これでは解析するにも、どういう構造かよくわかりません。一体どうなっているのでしょうか？
もしかしてEUC以外の文字コードで見ていませんか？
メモ帳は標準でJIS(ANSI?)で表示します。
EUCで見るとちゃんと番組表らしきものが得られます。
…うーん、面倒なのでWebBrowserコントロールを使って読み込むのがいいかもしれませんね。
Option Explicit
'1 Microsoft Internet Controlsコントロールにチェック
'2 WebBrowserコントロールをForm1に貼り付ける
'3 実行する
Private Sub Form_Load()
WebBrowser1.Navigate "http://tv.biglobe.ne.jp/20051111/P27/tv_hyou_2900.html"
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'Documentオブジェクトについては DOM でググってみてください
'多分見つかるはずです。
'そうでなければ、このメソッド中でStopを実行し、
'ローカルウィンドウでメソッドをゴリゴリ見て試してください。
Debug.Print pDisp.Document.body.outerhtml
End Sub
ご回答ありがとうございます。
ちょっとわからないのですが、
「Microsoft Internet Controlsコントロールにチェック」というのは、どこをどうすることなのでしょうか？
また「Documentオブジェクトについては DOM でググってみてください」の意味もよくわかりません。
すみませんけど、お願いします。
ん…最初の投稿のリンク先を見て、勝手にお使いの環境をVB6と仮定しましたが…
もし.NETなら私の範疇外です、すみません。
---VB6---
> 「Microsoft Internet Controlsコントロールにチェック」というのは、どこをどうすることなのでしょうか？
[プロジェクト]-[コンポーネント]を開いて、
Microsoft Internet Controlsにチェックをするということです。
> 「Documentオブジェクトについては DOM でググってみてください」の意味もよくわかりません。
googleで DOM を検索してほしい、という意味です。
ググる:
googleで検索することを言います。
google:
http://www.google.co.jp/
ありがとうございます。
当方VB6です。
[プロジェクト]-[コンポーネント]を開いてみたのですが、
やはり一覧にMicrosoft Internet Controlsはないようです。
Microsoft Internet Transfer Control6.0とは別物ですよね？
> [プロジェクト]-[コンポーネント]を開いてみたのですが、
> やはり一覧にMicrosoft Internet Controlsはないようです。
> Microsoft Internet Transfer Control6.0とは別物ですよね？
はい、別物です。
無いですか…うーん…Internet Explorerでも使ってみますか…
Private Sub Form_Load()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://www.google.co.jp/", False
Stop 'ローカルウィンドウでIE.Documentについて調べると幸せになれるかも
End Sub
もしActiveXコンポーネントを作成できないといったような例外が発生したら、
すみませんがど素人の私の手には負えません(TT
※MSXML使えそうなんだけどなぁ…よく分からない…
参考：
http://madia.world.coocan.jp/vb/vb_bbs/200401_04010013.html
ごちゃごちゃしてきたので、ここらでちょっとまとめてみました。
・IEで表示されているページをローカルディスクに
表示内容をそのままで保存したい。
・IEで表示されているページの画像などのリソースはネット上に存在するので、
それらのリソースをローカルに落とす必要がある。
・HTML中のリソースの存在場所も変える必要がある。
で、DOMさえ扱えるようになれば上手く行くという仮定の下で考えています。
InternetExplorer.Applicationオブジェクトで実験してみました。
Option Explicit
'1 Form1にCommandButtonを貼り付ける
'2 実行
'3 IE上のページが完了したら、CommandButton1を押す
'IE上のイメージのほとんどが"×"マークになるはず。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private IE As Object
Private Sub Form_Load()
'IEに読み込ませる
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://tv.biglobe.ne.jp/P27/"
IE.Visible = True
Do While IE.busy
DoEvents
Sleep 1
Loop
End Sub
Private Sub Command1_Click()
'HTMLImgオブジェクトに対してのみ、srcプロパティの"."を""に変える
'存在しないリソースを指定されることになるので、IE上でイメージが変換される。
'これを利用すれば…なんとかなるかな。
Dim v As Object
For Each v In IE.document.All
If TypeName(v) = "HTMLImg" Then
Debug.Print "v is Image:"; v.src;
v.src = Replace(v.src, ".", "")
Debug.Print " to "; v.src; "(outerHtml:" & v.outerhtml & ")"
End If
Next
End Sub
実験までしていただきありがとうございます。
それで、実行したんですが、
随分、時間かけてイメージを読み込む動作が起こったのですが、
これは何が行われているのですか？
このあと、どう扱えば良いのでしょうか？
すみません・・
本屋でＶＢの本を見たら、HTMLの形式を判定して、形式を変換するプログラムが載っていたのですが、それを使うのも一つの手なのでしょうか？
フリーのテキストエディタで番組表htmlを表示させたら、ちゃんと文字情報が表示されました。今さらながら、これがEUCなのですね。
最終的にはこういう↓ふうに保存したいのです。
（画像ファイルのフォルダ名がローカルに置き換わっている）
—————————————————————————————————
<TABLE cellSpacing=0 cellPadding=0>
<TBODY>
<TR vAlign=top>
<TD class=ch16><B>07:30</B></TD>
<TD class=ch16><B><IMG height=12
src="BIGLOBEテレビ番組051112A.files/moji.gif" width=12 border=0> <IMG
height=12 src="BIGLOBEテレビ番組051112A.files/stereo.gif" width=12
border=0> 遊戯王ＤＭ <IMG height=12
src="BIGLOBEテレビ番組051112A.files/again.gif" width=12
border=0></B><BR>▽神の一撃<BR><FONT
color=#666666><B>9631560</B></FONT></TD></TR></TBODY></TABLE></TD>
—————————————————————————————————
EUCの保存(JISに変換？)が解決していませんが、
先走りますが、
画像フォルダ名を置き換えながら、画像も保存する
サンプルプログラムありませんかね？
大変申し訳ないことが判明しました。
EUCであるというのがわからなかったため、
うまく保存されてないと思っていましたが、
どうやら当初のこのサンプルプログラムhttp://homepage2.nifty.com/inform/vbmania/source/geturl.htm
で一応ソースは保存されている
ことがわかりました。
ほんとにすみません。
あとはフォルダなどの置き換えです。
一文字ずつ解析するにはどうしたら良いでしょうか？
あと、改行が全然入ってないので、入れたいです。
振り回してしまってすみません。
htmlの１文字ずつを変数にとりこんで解析できると思いますが、
取り込み方がわかりません。
ぅーん…私も暴走している気がします(orz
> 随分、時間かけてイメージを読み込む動作が起こったのですが、これは何が行われているのですか？
随分かかりました？
ドキュメントが完了するまでの時間かと思いますが、
ウチではストレスなく読み込めましたので、ちょっとわからないですね…
> このあと、どう扱えば良いのでしょうか？すみません・・
DOMについてお調べになられましたでしょうか？
またStopステートメントを使った、メソッドの検索なども。
> あとはフォルダなどの置き換えです。
> 一文字ずつ解析するにはどうしたら良いでしょうか？
そのサンプルは単純にhttpのGETでデータを受信して、ローカルに保存するものです。
もとのソースはEUCなので、VBのStringで一文字ずつ解析するにはまずEUC→Unicodeの変換が必要です。
ADODB.Streamを使った方法があるようです。
参考：
http://madia.world.coocan.jp/vb/vb_bbs2/200401_04010054.html
混乱を招くかもしれませんが、
VBのString型で処理をせずにダウンロードしたままのByte()で処理をしても構いません。
もとのHTMLのコードを直接扱うことになりますが、変換による例外を発生せずに操作できます。
> あと、改行が全然入ってないので、入れたいです。
元のソースではちゃんと改行が入っていましたが…？
もしかして、適切なエンコード以外で表示したときに改行コードを識別できなかったというわけではないでしょうか？
> htmlの１文字ずつを変数にとりこんで解析できると思いますが、
> 取り込み方がわかりません。
HTMLを取り込むのは既に分かっていますので、
後はUnicodeにエンコードしてMid$()で一文字ずつ…というわけではない？
※眠い…
※適当に作ってみました。
Option Explicit
'1 Text1、Command1を貼り付ける
' このソースをコピー
' そのあと、必ず保存する。
'2 Command1を押し、保存する
' (現状ではすべてのリソースをもう一度ダウンロードするので遅い)
'3 何もなければ、同じディレクトリに保存されているはず。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private IE As Object
Private Inet As Object
Private Sub Form_Load()
'初期化(もしかしたらここで失敗するかも…)
Set IE = CreateObject("InternetExplorer.Application")
Set Inet = CreateObject("InetCtls.Inet")
Text1.Text = "http://tv.biglobe.ne.jp/P27/"
Command1.Caption = "保存"
End Sub
Private Sub Form_Unload(Cancel As Integer)
'終了処理
On Error Resume Next
If Not IE Is Nothing Then
IE.Quit
End If
End Sub
Private Sub Command1_Click()
'保存処理
Dim st As String
Set IE = New InternetExplorer
IE.Visible = True
Command1.Enabled = False
'IEに表示&保存
st = Text1.Text
IE.Navigate st
Text1.Text = "保存中"
Do While IE.Busy
DoEvents
Sleep 1
Loop
Call DownloadTest(VB.App.Path)
Text1.Text = st
Command1.Enabled = True
End Sub
Private Sub DownloadTest(ByVal ParentPath As String)
'表示されているものを保存する
Dim ff As Integer
Dim fileName As String
Dim img As MSHTML.HTMLImg
If Right$(ParentPath, 1) <> "\" Then ParentPath = ParentPath & "\"
With IE.Document
'URLから名前を取る
fileName = GetResourceName(.URL)
If fileName = "" Then
fileName = "名前なし"
End If
'子ディレクトリを一つ作成する
On Error Resume Next
MkDir ParentPath & fileName
On Error GoTo 0
'imgを保存し、そのパスに変更
For Each img In .images
img.src = SaveResource(ParentPath & fileName & "\", img.src)
Next
'bodyを保存する
fileName = fileName & ".htm" '拡張子を勝手につける
ff = FreeFile
Open ParentPath & fileName For Binary As ff
Put #ff, , .body.outerhtml
Close ff
End With
End Sub
Private Function GetResourceName(ByVal URL As String) As String
'URLから一番初めに出てくるリソース名を返す
Do
GetResourceName = Mid$(URL, InStrRev(URL, "/") + 1)
If Len(GetResourceName) Then Exit Do
URL = GetParentPath_URL(URL)
If URL = "" Then Exit Do
Loop
End Function
Private Function GetParentPath_URL(ByVal URL As String) As String
'URLの親パスを返す
Dim i As Long
i = InStrRev(URL, "/")
If i > 0 Then
GetParentPath_URL = Left$(URL, InStrRev(URL, "/") - 1)
End If
End Function
Private Function SaveResource(ByVal ParentPath As String, ByVal URL As String) As String
'URLのリソースを保存し、そのファイル名を返す
Dim filePath As String
Dim buf() As Byte
Dim ff As Integer
SaveResource = ParentPath & GetResourceName(URL)
buf = Inet.OpenURL(URL, 1) 'icByteArray
ff = FreeFile
Open SaveResource For Binary As ff
Put #ff, , buf
Close ff
End Function
ありがとうございます。
書いていただいたプログラムはエラーになったのですが、
一応今、EUCのまま解析するプログラムを作っています。
日本語の部分は特に変更はする必要ないのでEUCのままで良いと思うのですが、改行だけは認識してくれないのが問題です。
ところでVB上で実行して止まらなかったときに強制的に止める方法はありますでしょうか？
> 書いていただいたプログラムはエラーになったのですが、
ぁぁ…えーと、コンパイルエラーだと思いますがなんとかしてほしかったです(orz
もしかしたら、
> Dim img As MSHTML.HTMLImg
を
Dim img As Object
にすれば動くかもしれません。
> 日本語の部分は特に変更はする必要ないのでEUCのままで良いと思うのですが、改行だけは認識してくれないのが問題です。
もちろん改行もEUC…ですよね？
> ところでVB上で実行して止まらなかったときに強制的に止める方法はありますでしょうか？
Ctrl+Breakです。
今、ファイル名を抽出するところまでできました。
それで画像を保存しようとしたのですが、
例のこれで
http://homepage2.nifty.com/inform/vbmania/source/geturl.htm
画像も保存できると聞いていたのですが、
Open strFilename For Binary Access Write As #1のところで、
「パスがみつかりません」 のエラーになってしまいます。
画像保存のプログラムはこれで使えますよね？
それと、改行についてですが、
EUCのまま全体を扱っているので、EUCで入れなければならないのか
ちょっとわかりません。
> 「パスがみつかりません」 のエラーになってしまいます。
パスを正しく設定してください。
> 画像保存のプログラムはこれで使えますよね？
はい。
> それと、改行についてですが、
> EUCのまま全体を扱っているので、EUCで入れなければならないのか
> ちょっとわかりません。
そうですか…
(うーん、タグはAsciiで書かれてて、それ以外はEUCで書かれてる…
なわけないかな…)
※私は前のレスで書いたソースコードで満足できたので、
ゴリゴリHTMLソースを解析するのはあまり手伝えないと思います（ぉ
頑張ってください。
まだできあがってませんが、しばらく聞くことがなさそうなので、解決としておきます。ありがとうございました。
ガッさんのソースを試してみたところ
>> Dim img As MSHTML.HTMLImg
>を
>Dim img As Object
と
Private Sub Command1_Click()内の
Set IE = New InternetExplorer
を
'Set IE = New InternetExplorer
で動きました
>※私は前のレスで書いたソースコードで満足できたので
良いソースですね、参考にさせていただきます。
横からで悪いですが、ありがとうございます。
Set IE = New InternetExplorer
を
Set IE = CreateObject("InternetExplorer.Application")
でした。。すいません
あっ…！！(orz
すみません、まだバグがありましたね(TT
FALさん、デバッグどうもありがとうございます。
(お役に立てて嬉しいｗ)
| ツイート |  |