５．ちょっと便利なサイト内検索ソフト(08_Int_25)

１．ちょっと便利なサイト内検索ソフト(はじめに) ２．ちょっと便利なサイト内検索ソフト(ソースコード) ３．上記の実行結果 ４． ５．　 ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows 8.1 (Windows 7) / VB2013 (VB2010) / Framework 4.5.1 / 対象の CPU：x86 / Internet Explorer 11.0 Option　：[Compare Text] [Explicit On] [Infer On] [Strict On] Imports ：追加なし 参照設定：System.Web 使用コン： トロール： このサンプル等の内容を無断で転載、掲載、配布する事はお断りします。(私の修正・改訂・削除等が及ばなくなるので) 必要ならリンクをはるようにして下さい。(引用の場合は引用元のリンクを明記して下さい)

１．ちょっと便利なサイト内検索ソフト(はじめに)

元々は、VB6.0 で作成して EXE をフリーソフトとして公開していたものを VB2010等でもサンプル集に収録していて使っていたのですが、Google サイトが時々書き換えられたり、プログラム上からの操作に制限をかけられたりするので、今回 VB2013 でのサンプル見直しを機に作り直した物です。 当時の作成過程等は雑談用掲示板に記載してありますのでご覧下さい。 今回からの変更部分は、頻繁に使用すると Google サイトに制限をかけられるので、Yahoo でも検索できるように設定しております。 URL を短くするのに今回から、is.gd に変更しました。 検索は、URL にキーワードを含めて検索するように変更しました。 　図１．実行結果と使用コントロール類と配置図 　 　上記 EXE 版のダウンロード(hit.zip 97KB) Windows 8.1/VB2013/Framework 2.0/対象の CPU：x86 でコンパイル   (うまく動作しない場合は、下記コードを使ってご自分で作成して下さい)

２．ちょっと便利なサイト内検索ソフト(ソースコード)

'======================================================================================================================= 'SampleNo：08_Int_25 (旧、SampleNo.428)    2015/02/10     �@ 2015/02/10 'タイトル：ちょっと便利なサイト内検索ソフト(08_Int_25) - VB2013 '動作確認：Windows 8.1 (Windows 7) / VB2013 (VB2010) / Framework 4.5.1 / 対象の CPU：x86 '          Excel 2010 / Excel 2013 / Internet Explorer 11.0 / '[Option Compare Text] [Option Explicit On] [Option Infer On] [Option Strict On]で設定 '----------------------------------------------------------------------------------------------------------------------- 'プロジェクト → 参照の追加(VB2012〜) → アセンブリ → フレームワーク → System.Web を参照設定しておいて下さい。 'ソースコードは、保存オプションの詳細設定で、日本語(シフトJIS)-コードページ932 で保存しております。 '========1=========2=========3=========4=========5=========6=========7=========8=========9=========0=========1=========2 'コードを折りたたむ方法と展開する方法 - #035 'http://blogs.msdn.com/vstipsjpn/archive/2008/05/22/8386191.aspx 'すべて折りたたむ = CTR + M,O　　すべて展開 = CTR + M,L   個別展開・折りたたみ = 範囲選択して CTR + M,M   Public Class Form1 #Region "本文関係の処理(Button_Click イベントの処理等)" Dim myURL As String                 '表示ページの URL Private sNo As Integer = 0          '検索作業の順番 Private sitoNo As Integer = 0       '検索対象サイトの順番 Private google As Boolean = True    '検索エンジンの選択 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click     google = RadioButton1.Checked   'どちらの検索エンジンが選択されているかを取得     WebBrowser1.ScriptErrorsSuppressed = True     Dim keyWord As String = Web.HttpUtility.UrlEncode(TextBox1.Text, System.Text.Encoding.GetEncoding("utf-8"))     '検索エンジンの選択     If google Then         myURL = "https://www.google.co.jp/search?ie=UTF-8&q=" & keyWord     Else         myURL = "http://search.yahoo.co.jp/search?p=" & keyWord & "&aq=-1&oq=&ei=UTF-8&fr=sfp_as&x=wrt"     End If     wSite(0, 2) = myURL                  'ウェブ全体から検索用 URL       SortList = New List(Of String)      '結果の保存用 List     ListBox1.Items.Clear()              '取得データ保存・表示用     For i = 1 To UBound(wSite, 1)         If google Then             myURL = "https://www.google.co.jp/search?ie=UTF-8&q=" & wSite(i, 1) & keyWord         Else             myURL = "http://search.yahoo.co.jp/search?p=" & wSite(i, 1) & keyWord & "&aq=-1&oq=&ei=UTF-8&fr=sfp_as&x=wrt"         End If         wSite(i, 2) = myURL     Next     sNo = 0         '作業 No     sitoNo = 0      '検索対象サイト No     Label1.Text = "只今、" & wSite(sitoNo, 0).Trim & "を検索中"     WebBrowser1.Navigate(wSite(sitoNo, 2))   'Web 全体 〜 検索を開始 End Sub Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs _                                                                 ) Handles WebBrowser1.DocumentCompleted     If sNo = 0 Then         Label1.Text = "只今、" & wSite(sitoNo, 0).Trim & "を検索中"         If google Then      'google を使用した場合             '検索結果のヒット件数が見つからない場合の処理             If WebBrowser1.Document.GetElementById("resultStats") Is Nothing Then  'Google の場合                 wSite(sitoNo, 2) = ""    '検索した URL                 wSite(sitoNo, 3) = "0"   '見つかった件数                 wSite(sitoNo, 4) = ""    '検索結果の短い URL                 'ヒット件数の並べ替え用のデータを取得・保存                 SortList.Add(wSite(sitoNo, 3).PadLeft(12, "0"c) & "," & sitoNo.ToString)                 sNo = 0                 '作業 No を最初の状態に設定                 sitoNo += 1             '次の検索対象サイトを設定                 If sitoNo > UBound(wSite, 1) Then                     '検索が終了した場合、結果を ListBox に表示                     Call TextWrite()                     Exit Sub                 End If                 WebBrowser1.Navigate(wSite(sitoNo, 2))   '次の検索対象サイトを検索表示                 Exit Sub             Else                 '検索結果、ヒット件数が見つかった場合の処理                 Dim hitken As String = WebBrowser1.Document.GetElementById("resultStats").InnerText                 Dim n1 As Integer = hitken.IndexOf("件")                 If n1 > 1 Then                     'ヒット件数(約 3,600 件 / 約3,600件　)の文字から[件]と[約]の文字を取り除く　                     hitken = hitken.Substring(0, n1 - 1).Replace("約 ", "").Trim 'Google と yahoo では違います。                     Dim hitCount As Integer = CInt(hitken)                     wSite(sitoNo, 3) = hitCount.ToString                     sNo = 1                         '検索結果、見つかった場合そのURLを短縮                     WebBrowser1.ScriptErrorsSuppressed = True                     myURL = "http://is.gd/"                     WebBrowser1.Navigate(myURL)                     Exit Sub                 End If             End If         Else    'yahoo を使用した場合             '検索結果のヒット件数が見つからない場合の処理             Dim hitken As String = WebBrowser1.Document.GetElementById("Sf2").InnerText             Dim n1 As Integer = hitken.IndexOf("件")             If n1 < 1 Then                 wSite(sitoNo, 2) = ""    '検索した URL                 wSite(sitoNo, 3) = "0"   '見つかった件数                 wSite(sitoNo, 4) = ""    '検索結果の短い URL                 SortList.Add(wSite(sitoNo, 3).PadLeft(12, "0"c) & "," & sitoNo.ToString)                 sNo = 0                 '作業 No を最初の状態に設定                 sitoNo += 1             '次の検索対象サイトを設定                 If sitoNo > UBound(wSite, 1) Then                     '検索が終了した場合、結果を ListBox に表示                     Call TextWrite()                     Exit Sub                 End If                 WebBrowser1.Navigate(wSite(sitoNo, 2))                 Exit Sub             Else                 '検索結果ヒット件数が見つかった場合の処理                 'ヒット件数(約 3,600 件 / 約3,600件　)の文字から[件]と[約]の文字を取り除く　                 hitken = hitken.Substring(0, n1)                 hitken = hitken.Substring(0, n1).Replace("約", "").Trim  'Google と yahoo では違います。                 Dim hitCount As Integer = CInt(hitken)                 wSite(sitoNo, 3) = hitCount.ToString                 sNo = 1             '検索結果、見つかった場合そのURLを短縮                 WebBrowser1.ScriptErrorsSuppressed = True                 myURL = "http://is.gd/"                 WebBrowser1.Navigate(myURL)                 Exit Sub             End If         End If     End If     If e.Url.ToString = myURL And sNo = 1 Then         '長いURLを書き込み短縮する         WebBrowser1.Document.GetElementsByTagName("input").Item("url").SetAttribute("value", wSite(sitoNo, 2))         WebBrowser1.Document.Forms(0).InvokeMember("submit")         myURL = "http://is.gd/create.php"       '変換結果が表示される URL         sNo = 2                                 '次の作業 No へ         Exit Sub     End If                             '     If e.Url.ToString = myURL And sNo = 2 Then  '変換結果が表示されたページを取得した場合         '長いURLを書き込み短縮した結果を表示されたテキストボックスの内容を取得         Dim txt As String = WebBrowser1.Document.GetElementById("short_url").GetAttribute("value")         wSite(sitoNo, 4) = txt   '検索結果の短い URL を保存         'ヒット件数の並べ替え用のデータを取得・保存         SortList.Add(wSite(sitoNo, 3).PadLeft(12, "0"c) & "," & sitoNo.ToString)         sNo = 0         sitoNo += 1         If sitoNo > UBound(wSite, 1) Then             '検索が終了した場合、結果を ListBox に表示             Call TextWrite()             Exit Sub         End If         WebBrowser1.Navigate(wSite(sitoNo, 2))   '次のサイトを検索     End If End Sub #End Region #Region "付帯処理関係(関数・メソッド及びWin32 API 関数の宣言及び変数の宣言等含む)" Private Sub TextWrite() '検索結果のヒット数の多い順に並べ替えて ListBox に表示         SortList.Sort()     SortList.Reverse()     WebBrowser1.Navigate("about:blank")     Label1.Text = "検索が完了しました"     For Each s1 As String In SortList         Dim Dat() As String = s1.Split(","c)         Dim ans As String = ""         ans = Format(CInt(wSite(CInt(Dat(1)), 3)), " #,##0 件   ")         Dim keta As Integer = Format(CInt(wSite(0, 3)), " #,##0 件   ").Length         ListBox1.Items.Add(ans.PadLeft(keta + 2, " "c) & vbTab & wSite(CInt(Dat(1)), 0) & vbTab & wSite(CInt(Dat(1)), 4))     Next End Sub Private Sub ListBox1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.Click 'ListBox の選択項目がクリックされたらその URL を表示     Dim strurl As String = ListBox1.Text     Dim link() As String = strurl.Split(CChar(vbTab))     If strurl.Length = 0 Then Exit Sub     If link(2).Trim.Length > 4 Then         If CheckBox1.Checked Then             System.Diagnostics.Process.Start(link(2).Trim)         Else             WebBrowser1.Navigate(link(2).Trim)         End If     End If End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click '検索結果の ListBox の内容をクリップボードにコピー     Dim myText As String = ""     myText &= "ちょっと便利なサイト内検索ソフト(08_Int_25)を使って、" & vbCrLf     myText &= "キーワード【" & TextBox1.Text & "】での検索結果" & vbCrLf & vbCrLf     For i As Integer = 0 To ListBox1.Items.Count - 1         myText &= ListBox1.Items(i).ToString() & vbCrLf     Next     System.Windows.Forms.Clipboard.SetDataObject(myText, True) End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click     'ナビゲーション履歴に前のページがあるかどうかを示す値を取得します。     '(下記判定は、特に無くても問題ありません。)     If WebBrowser1.CanGoBack Then         'ナビゲーション履歴に前のページがある場合に、WebBrowser コントロールを前のページに戻します。         WebBrowser1.GoBack()     End If End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click     'ナビゲーション履歴に次のページがあるかどうかを示す値を取得します。     '(下記判定は、特に無くても問題ありません。)     If WebBrowser1.CanGoForward Then         'ナビゲーション履歴に次のページがある場合に、WebBrowser コントロールを次のページに移動します。         WebBrowser1.GoForward()     End If End Sub #End Region #Region "起動時の処理(Form1_Load イベント等の処理" Private wSite(13, 4) As String          '検索対象サイトのデータ収納用 Private SortList As List(Of String)     '検索結果のヒット件数の並べ替え用データ Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load     Me.Location = My.Settings.FormLocation  '終了時の Form の位置を反映     Me.Size = My.Settings.FormSize          '終了時の Form のサイズを反映 '------------------------------------------------------------------------------     wSite(0, 0) = "■ウェブ全体　　　　         " : wSite(0, 1) = ""     wSite(1, 0) = "★VBレスキュー(花ちゃん)     " : wSite(1, 1) = "+site:hanatyan.sakura.ne.jp/+"     wSite(2, 0) = "●msdn.microsoft.com/        " : wSite(2, 1) = "+site:msdn.microsoft.com/+"     wSite(3, 0) = "教えて！goo                  " : wSite(3, 1) = "+site:oshiete.goo.ne.jp/+"     wSite(4, 0) = "Programing Library           " : wSite(4, 1) = "+site:homepage1.nifty.com/MADIA/+"     wSite(5, 0) = "わんくま同盟のBBS            " : wSite(5, 1) = "+site:bbs.wankuma.com/+"     wSite(6, 0) = "VB初心者友の会               " : wSite(6, 1) = "+site:gizcollabo.jp/vbtomo/+"     wSite(7, 0) = "DOBON.NET                    " : wSite(7, 1) = "+site:dobon.net/+"     wSite(8, 0) = "Yahoo!知恵袋 　　　　　      " : wSite(8, 1) = "+site:chiebukuro.yahoo.co.jp/+"     wSite(9, 0) = "VB中学校(掲示板) 　　        " : wSite(9, 1) = "+site:rucio.cloudapp.net/+"     wSite(10, 0) = "VB中学校(一般)  　　         " : wSite(10, 1) = "+site:homepage1.nifty.com/rucio/+"     wSite(11, 0) = "C# と VB.NETの入門サイト     " : wSite(11, 1) = "+site:jeanne.wankuma.com/+"     wSite(12, 0) = "moug モーグ(VBA)  　　　     " : wSite(12, 1) = "+site:moug.net/+"     wSite(13, 0) = "Visual Basic Station         " : wSite(13, 1) = "+site:vbstation.net/+"     Me.TopMost = True End Sub #End Region #Region "終了時の処理(テスト用ファイルの後始末・他)" Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing     My.Settings.FormLocation = Me.Location  '終了時の Form の位置を保存     My.Settings.FormSize = Me.Size          '終了時の Form のサイズを保存 End Sub #End Region End Class

３．上記の実行結果

ちょっと便利なサイト内検索ソフト(08_Int_25)を使って、 キーワード【Visual Basic】での検索結果    80,900,000 件   ■ウェブ全体　　　　         http://is.gd/Xv6PEH     2,060,000 件   ●msdn.microsoft.com/        http://is.gd/yENlJ3       251,000 件   Yahoo!知恵袋 　　　　　      http://is.gd/0gMZ5W       106,000 件   教えて！goo                  http://is.gd/Y1D08w        15,200 件   ★VBレスキュー(花ちゃん)     http://is.gd/zrPEcP         5,450 件   Programing Library           http://is.gd/JSf62t         3,040 件   DOBON.NET                    http://is.gd/cslOFJ         3,010 件   VB中学校(掲示板) 　　        http://is.gd/1y4rjs         2,900 件   VB初心者友の会               http://is.gd/mRHFJR         2,890 件   わんくま同盟のBBS            http://is.gd/JdAdkG         1,430 件   VB中学校(一般)  　　         http://is.gd/Q1Du1i           956 件   C# と VB.NETの入門サイト     http://is.gd/oZ3uZg           496 件   moug モーグ(VBA)  　　　     http://is.gd/8FaXvK           371 件   Visual Basic Station         http://is.gd/AXgp9X

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)