インターネットで探し物
かなりやばいものを作ってしまった。。。。ベクターには公開できんなぁ。。。。
「Mail De Watch」を作って以来、ちょっとしたインターネット通信プログラムがおもしろくなってしまい、情報収集機能をもつプログラムを作ってみたくなったんで
す。インターネットには情報があふれています。検索エンジンなどがよい例ですね。でも、いろんなサイトを探すのに手作業で探すのは面倒。知りたい情報を
もったページをスコンと抜けるとおもしろいなぁ、ということで今回は自動的に探すサンプルプログラムを作ってみました。
ただ。。。。。。。一番簡単な例としてメールアドレスを発見するようにしてみたのですが、巷にはMAILCATCHERとかMAILFINDERとかいっ
てそういうソフトがとても高価な値段で売られており、ヤバヤバツールと認定されているようです。まぁ、SPAMメールをばらまく元といえばそうですもん
ね。対抗策としてアクセスしてきたらデタラメなメールアドレスを大量に生成して返す、なんていうWPOISONなんていうおもしろいソフトを作っている人もいます。
というわけで今回はわざとパッケージには実行モジュールは含まれていません。あくまでも研究用にVBのソースだけ置いておきます。
このプロセスはふたつのフェーズにわけました。最初にやるべきことは、候補のURLを探すことです。例えばGoogleで検索結果のページでもいい
ですし、なんらかの形のリンク集を拾い出し、そのリンクを順順に辿ってみることにしました。一番重要なルーチンが以下のルーチンです。
Private Sub BtnStart_Click() Dim i As Long Dim Contents As String Dim ArrayBin() As Byte
BtnStart.Enabled = False bitSTOP = False ListURL.Clear Call Init_Inet InetScan.URL = TxtURL.Text ----(1) On Error Resume Next ArrayBin() = InetScan.OpenURL(, icByteArray) ---(2) On Error GoTo 0 Contents = StrConv(ArrayBin, vbUnicode) Call ScanLink(Contents) ---(3) DoEvents If ListURL.ListCount = 0 Then Exit Sub End If i = 0 Do While (i < (ListURL.ListCount - 1)) ---(4) lblDoing.Caption = "リストの" & CStr(i) & _ "番目を調査中。発見したURL数は" & CStr(ListURL.ListCount) If CLng(TxtMaxURL.Text) < i Then InetScan.Cancel BtnStart.Enabled = True Exit Sub End If InetScan.URL = ListURL.List(i) On Error Resume Next ArrayBin() = InetScan.OpenURL(, icByteArray) On Error GoTo 0 Contents = StrConv(ArrayBin, vbUnicode) Call ScanLink(Contents) DoEvents If bitSTOP Then ---(5) InetScan.Cancel BtnStart.Enabled = True Exit Sub End If i = i + 1 Loop BtnStart.Enabled = True End Sub
|
(1)で、InetScanというのは、VBのInetコンポーネントです。これはなかなか便利でプロキシーの設定などもできてHTTP(いわゆる
WEB)のデータを取ってきてくれます。その取る動作が(2)のopenURLというメソッドです。これだけでも、例えば右クリックができないようになっ
ているJavaScriptいりのページのソースを入手することができますね。ここはページがきちんと送られてこなかったり、タイムアウトでエラーになり
やすいのでon
Errorステートメントでエラーをキャンセルしています。うーん、通信プログラムっぽい。
インターネットで入手する情報はさまざまな文字コードで記述されています。EUC,SHIFT-JIS,UNICODEなど聞いたことがあるでしょう?で
すから、VBで処理する場合は普通のSTRINGではなく、バイト配列で受け取ります。STRINGはVBの思っている文字コード(UNICODE)に無
理に文字を変更しようとしたりするので、そういう心配のないバイト配列で受け取り、STRCONV関数でUNICODEに変更しています。これでもイマイ
チヘンなのですが、今回はURLという英語でしかできていないに決まっているものを扱うのでこれでいいことにしています。
(3)はそのもってきたページの内容からHTMLのHREFキーワードを見つけてリンクしているURLを拾い出そうというものです。見つけ出したURLは
すべてLISTBOXに書き出していますので、(4)の部分の数はどんどん増えていきます。つまりこのプログラムはリンクを拾い出してはそのリンクにアク
セスし、また、そのリンクを拾い出していくので放っておくとどこまでもURLを収集しまくってしまいます。で、(5)のタイミングで「中止ボタン」が押さ
れていないかチェックして押されていたら作業を止めるようになっています。
VBのソースパッケージはページの一番下にリンクがあります。実行してみると一万URLなんて簡単に集まるもんですね。ビックリ!データを保管するとき、
そのURLが目的のものか、正規表現でフィルタリングする機能もつけてみました。拾ったものをそのまま保管したい人はソースからregedit関連をとっ
ぱずすとよいでしょう。
以下はほぼ同じ機能をIEを利用してスクリプトで作った例。コレクションオブジェクトがスクリプトでは使えないんで配列の定義で拾いたい最大数を指定してください。BASP21を使っていますので、別途、インストールしてください。
' URLFinder.VBS by T.Takao
option explicit
Dim URLList( 1000 ) Const FileName = "URLList.csv" '書き出すファイル名
Dim objIE 'IEオブジェクト Dim objFS 'ファイルシステムオブジェクト Dim objFH 'ファイルシステムハンドル Dim objBasp 'BASP21 Dim URL ' 最初のURL Const ForAppending = 8 Dim i 'カウンター Dim CountURL Dim MaxURL '最大URL数 MaxURL = UBound(URLLIST)-1
Call Main()
msgbox "終了" '--------------------------------------------------- Sub Main() dim stream
'IEのインスタンスを作成 Set objIE = CreateObject("InternetExplorer.Application")
Set objBasp = CreateObject("basp21")
URL = inputbox("最初のURLを入力します。(http:から)") if URL = "" then Exit Sub End if
' 最初のナビゲート objIE.Navigate(URL) Call LoadWait objIE.Visible = True '動きをみたい方はこちらをどうぞ
CountURL = 0 for each URL in objIE.Document.Links URLList(CountURL) = objBasp.kconv( URL.Href,4) CountURL = CountURL + 1 next
i=0 Do while (CountURL < MaxURL) objIE.Navigate( URLList( i ) ) i = i + 1 Call LoadWait for each URL in objIE.Document.Links if CountURL > MaxURL then exit for end if URLList( CountURL ) = objBasp.kconv( URL.Href,4) CountURL = CountURL + 1 Next Loop
objIE.Quit Set objIE = Nothing
Call WriteOut()
End Sub
sub LoadWait()
'ロード待ち do while (objIE.busy) loop do while (objIE.Document.readyState <> "complete") Loop End Sub
Sub WriteOut() Set objFS = CreateObject("Scripting.FileSystemObject") Set objFH = objFS.OpenTextFile(FileName, ForAppending, True) for i = 0 to MAXURL objFH.WriteLine URLLIST(i) next objFH.Close set objFS = Nothing End Sub
|
続いて、URLからメールアドレス(あくまでも例ですよ、例!)を拾い出すプログラムの要の部分をご紹介しましょう。
Private Sub BtnStart_Click() Dim i As Long Dim Contents As String Dim ArrayBin() As Byte Dim URLname As Variant
BtnStart.Enabled = False bitSTOP = False ListMail.Clear For i = 1 To colURL.Count colURL.Remove 1 Next Call LoadURL Call Init_Inet For Each URLname In colURL ---(1) InetScan.URL = URLname On Error Resume Next ArrayBin() = InetScan.OpenURL(, icByteArray) ---(2) On Error GoTo 0 Contents = StrConv(ArrayBin, vbUnicode) Call ScanAtMark(Contents) ---(3) DoEvents LblDoing.Caption = URLname & "探索中" & vbCrLf _ & "発見したメアド数 " & CStr(ListMail.ListCount) If bitSTOP Then ---(4) InetScan.Cancel BtnStart.Enabled = True Exit Sub End If Next BtnStart.Enabled = True End Sub
|
最初のプログラム(URLFinder)で探し出したURLはCSVファイルに保管されているとします。効率を高めたい人はリストをエクセルかなにかで処理して重複URLを除くといいでしょうね。
(1)ではLoadURLで読み込んだコレクションオブジェクトからひとつづつURL名を取り出しています。インターネットプログラムは最初のURLを探
すものとほぼ同じです。(2)でinetコンポーネントのopenURLメソッドでページを拾い出し、コード変換して、(3)でScanAtMarkで
メールにつきものの@マークを探しています。(4)は途中停止したいときの処理です。
いずれもネットワーク処理は簡単でした。むしろ難しいのは、読み込んだHTMLからどうやってリンクしているURLを取り出すか、どうやってメールアドレスを取り出すか、というテキスト処理部分でした。
このサンプルプログラムでは、HREFタグを見つけたら、そこを候補として切り出します。
次に、文字列を解析しダブルクォーテーションやブランクという区切りを見つけ、URLとしています。しかしやってみるとわかるように結構、ゴミも拾いま
す。同様にメールも@マークを見つけ前後50バイトを取り出し、@マークを中心としてアカウントとドメイン名を拾い出すという作業をやっています。これも
やってみるとわかるように@niftyなんてのも拾ってきてタイヘンです。
こうやってみると、インターネットから情報を収集するプログラムはデータをもってくるのは簡単で、そのテキスト処理がタイヘンであることがわかりました。時間ができたらページの要約を抽出できないかやってみたいところです。