IE キャプチャー

  キャプチャー方法はエクスプローラキャプチャーと同じ





※ IE6 でのみ確認いたしました

↓エクスプローラキャプチャー
http://winofsql.jp/VA003334/dnettool080531211312.htm

今回は、単純にウインドウハンドルだけを使うのでは無く、イベントも捕獲しています。
処理は、エクスプローラのように簡単には行かず、無理をすると異常終了するので、
非表示は行っていません。

イベント内ではフラグだけをセットして、GUI 操作はタイマー処理にまかせました。





  コード









  
Imports System.Runtime.InteropServices

Public Class Form1

	' ***************************************************************
	' API 定義
	' ***************************************************************
	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Private Shared Function MoveWindow( _
	ByVal hwnd As IntPtr, ByVal x As Integer, ByVal y As Integer, _
	   ByVal nWidth As Integer, ByVal nHeight As Integer, _
	   ByVal bRepaint As Integer) As Integer
	End Function

	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Public Shared Function ShowWindow(ByVal hWnd As Integer, _
	 ByVal nCmdShow As Integer _
	 ) As Integer
	End Function

	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Public Shared Function SetForegroundWindow(ByVal hWnd As Integer _
	 ) As Integer
	End Function

	Const SW_RESTORE = 9
	Const SW_HIDE = 0
	Const SW_SHOW = 5

	' ***************************************************************
	' グローバル
	' ***************************************************************
	Private timer As Timer = New Timer()
	Private obj As New Shell32.Shell()

	' ***************************************************************
	' 初期処理
	' ***************************************************************
	Private Sub Form1_Load(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.Load

		' 本体の初期位置と初期サイズ( タブコントロールはアンカーで処理 )
		Me.Left = 0
		Me.Top = 0
		Me.Width = Screen.PrimaryScreen.Bounds.Width

		' 初期の捕獲
		For Each obj2 As Object In obj.Windows
			If "mshtml.HTMLDocumentClass" = obj2.Document.ToString() Then


				Dim page As New LboxTabPage( _
				 Me, _
				 obj2.Document.title, _
				 obj2.HWND(), _
				 TabControl1, _
				 obj2 _
				 )
				Me.TabControl1.TabPages.Add(page)

			End If

		Next

		' 先頭タブを選択
		Try

			If TabControl1.TabCount <> 0 Then
				Me.TabControl1.SelectTab(0)
				CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
			End If

		Catch ex As Exception

		End Try

		' タイマー設定
		AddHandler timer.Tick, New EventHandler(AddressOf DirChange)
		timer.Interval = 1000
		timer.Enabled = True

	End Sub


	' ***************************************************************
	' 一定時間の処理
	' ***************************************************************
	Private Sub DirChange(ByVal sender As Object, ByVal e As EventArgs)

		timer.Enabled = False

		If TabControl1.TabCount <> 0 Then
			' 選択されているタブのタイトルを変更する
			Dim CurPage As LboxTabPage = TabControl1.SelectedTab
			CurPage.Change()

			' イベントにより、タイトルが変更されている場合変更する
			Dim PageCount As Integer = TabControl1.TabPages.Count
			For I As Integer = 0 To PageCount - 1
				CurPage = TabControl1.TabPages(I)
				If CurPage.testFlg Then
					CurPage.Change()
					CurPage.testFlg = False
				End If
			Next
		End If

		For Each obj2 As Object In obj.Windows

			Try

				If Not obj2.Busy Then
				  If "mshtml.HTMLDocumentClass" = obj2.Document.ToString() Then

				    ' 重複しないように新規の IE を登録
				    Dim flg As Boolean = False
				    Dim PageCount As Integer = TabControl1.TabPages.Count
				    Dim CurPage As LboxTabPage = Nothing
				    For I As Integer = 0 To PageCount - 1
				      CurPage = TabControl1.TabPages(I)
				      If CurPage.curHandle = obj2.HWND() Then
				        flg = True
				      End If
				    Next

				    If Not flg Then

				      Dim page As LboxTabPage
				      page = New LboxTabPage( _
				        Me, _
				        obj2.Document.title, _
				        obj2.HWND(), _
				        TabControl1, _
				        obj2 _
				        )
				      ' 該当 IE を登録
				      Me.TabControl1.TabPages.Add(page)
				      ' 該当 IE を前面に表示
				      page.SetWindow()
				      ' 追加されたタブを選択
				      Me.TabControl1.SelectTab(Me.TabControl1.TabCount - 1)

				    End If

				  End If
				End If

			Catch ex As Exception

			End Try

		Next

		timer.Enabled = True

	End Sub

	' ***************************************************************
	' 選択した時
	' ***************************************************************
	Private Sub TabControl1_SelectedIndexChanged(ByVal sender As System.Object, _
	  ByVal e As System.EventArgs) Handles TabControl1.SelectedIndexChanged

		timer.Enabled = False

		If TabControl1.TabCount <> 0 Then
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		End If

		timer.Enabled = True

	End Sub


	' ***************************************************************
	' サイズ変更時
	' ***************************************************************
	Private Sub Form1_ResizeEnd(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.ResizeEnd

		timer.Enabled = False

		If TabControl1.TabCount <> 0 Then
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		End If

		timer.Enabled = True

	End Sub

	' ***************************************************************
	' 最小化されたカレントを元に戻す
	' ***************************************************************
	Private Sub TabControl1_DoubleClick(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles TabControl1.DoubleClick

		timer.Enabled = False

		If TabControl1.TabCount <> 0 Then
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		End If

		timer.Enabled = True

	End Sub


	' ***************************************************************
	' 終了時
	' ***************************************************************
	Private Sub Form1_FormClosed(ByVal sender As System.Object, _
	ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed

		timer.Enabled = False

		If TabControl1.TabCount <> 0 Then
			Dim PageCount As Integer = TabControl1.TabPages.Count
			Dim CurPage As LboxTabPage = Nothing
			Dim handle As Integer = 0
			For I As Integer = 0 To PageCount - 1
				CurPage = TabControl1.TabPages(I)
			Next
		End If

	End Sub

	' ***************************************************************
	' 内部タブページ
	' ***************************************************************
	Private Class LboxTabPage
		Inherits System.Windows.Forms.TabPage

		Public curHandle As Integer
		Public TabControl As TabControl = Nothing
		Public curObject As Object
		Public baseForm As Form
		Public testFlg As Boolean = False
		Private web As SHDocVw.WebBrowser

		Public Sub New( _
		 ByVal base As Form, _
		 ByVal target As String, _
		 ByVal hWnd As Integer, _
		 ByVal tab As TabControl, _
		 ByVal Window As Object)

			MyBase.New(target)

			Me.curHandle = hWnd
			Me.TabControl = tab
			Me.curObject = Window
			Me.baseForm = base
			web = Window

			AddHandler web.DocumentComplete, AddressOf inner_DocumentComplete
			AddHandler web.BeforeNavigate2, AddressOf inner_BeforeNavigate2
			AddHandler web.NavigateComplete2, AddressOf inner_NavigateComplete2

		End Sub

		Public Sub SetWindow()

			Dim base As New System.Drawing.Point(-9, baseForm.ClientSize.Height - 14)
			Dim pos As System.Drawing.Point = Me.PointToScreen(base)

			Try
				If Not curObject.Busy Then

					SetForegroundWindow(curHandle)
					ShowWindow(curHandle, SW_RESTORE)

					MoveWindow( _
					 curHandle, _
					 pos.X + 1, _
					 pos.Y, _
					 baseForm.Width, _
					 Screen.PrimaryScreen.Bounds.Height - pos.Y - 50, _
					 1 _
					)

					ShowWindow(curHandle, SW_RESTORE)
					'baseForm.Activate()

				End If
			Catch ex As Exception
				TabControl.TabPages.Remove(Me)
			End Try

		End Sub

		Public Sub Change()

			Try
				If Not curObject.Busy Then
					Dim str As String = curObject.Document.title.ToString()
					If str.Length > 10 Then
						Me.Text = str.Substring(0, 10)
					Else
						Me.Text = str
					End If

				End If
			Catch ex As Exception
				TabControl.TabPages.Remove(Me)
			End Try

		End Sub

		Private Sub inner_DocumentComplete( _
		 ByVal pDisp As Object, _
		 ByRef URL As Object)

			testFlg = True

#If DEBUG Then
			Dim str As String = pDisp.Document.title + ":" + URL.ToString()
			Console.WriteLine("DocumentComplete:" + str)
#End If
		End Sub

		Private Sub inner_BeforeNavigate2( _
		  ByVal pDisp As Object, _
		  ByRef url As Object, _
		  ByRef Flags As Object, _
		  ByRef TargetFrameName As Object, _
		  ByRef PostData As Object, _
		  ByRef Headers As Object, _
		  ByRef Cancel As Boolean)
#If DEBUG Then
			Dim str As String = pDisp.Document.title + ":" + url.ToString()
			Console.WriteLine("BeforeNavigate2:" + str)
#End If
		End Sub

		Private Sub inner_NavigateComplete2( _
		  ByVal pDisp As Object, _
		  ByRef URL As Object)
#If DEBUG Then
			Dim str As String = pDisp.Document.title + ":" + URL.ToString()
			Console.WriteLine("NavigateComplete2:" + str)
#End If
		End Sub

	End Class

End Class
  



  invoke メソッドで、inner_DocumentComplete からタイトル変更

これにより、タイマー処理内の以下の処理は必要無くなります

  
If TabControl1.TabCount <> 0 Then
	' 選択されているタブのタイトルを変更する
	Dim CurPage As LboxTabPage = TabControl1.SelectedTab
	CurPage.Change()

	' イベントにより、タイトルが変更されている場合変更する
	Dim PageCount As Integer = TabControl1.TabPages.Count
	For I As Integer = 0 To PageCount - 1
		CurPage = TabControl1.TabPages(I)
		If CurPage.testFlg Then
			CurPage.Change()
			CurPage.testFlg = False
		End If
	Next
End If
  

  
' ***************************************************************
' 内部タブページ
' ***************************************************************
Private Class LboxTabPage
	Inherits System.Windows.Forms.TabPage

	' デリゲートの定義
	Delegate Function ProcBridge(ByVal str As String) As Integer

	Public curHandle As Integer
	Public TabControl As TabControl = Nothing
	Public curObject As Object
	Public baseForm As Form
	Public testFlg As Boolean = False
	Private web As SHDocVw.WebBrowser

	' こちら側のメソッド
	Private Function ThisProcBridge(ByVal str As String) As Integer

		Me.baseForm.Text = str
		Me.Change()

	End Function


	Public Sub New( _
	  ByVal base As Form, _
	  ByVal target As String, _
	  ByVal hWnd As Integer, _
	  ByVal tab As TabControl, _
	  ByVal Window As Object)

		MyBase.New(target)

		Me.curHandle = hWnd
		Me.TabControl = tab
		Me.curObject = Window
		Me.baseForm = base
		web = Window

		AddHandler web.DocumentComplete, AddressOf inner_DocumentComplete
		AddHandler web.BeforeNavigate2, AddressOf inner_BeforeNavigate2
		AddHandler web.NavigateComplete2, AddressOf inner_NavigateComplete2

	End Sub

	Public Sub SetWindow()

		Dim base As New System.Drawing.Point(-9, baseForm.ClientSize.Height - 14)
		Dim pos As System.Drawing.Point = Me.PointToScreen(base)

		Try
			If Not curObject.Busy Then

				SetForegroundWindow(curHandle)
				ShowWindow(curHandle, SW_RESTORE)

				MoveWindow( _
				 curHandle, _
				 pos.X + 1, _
				 pos.Y, _
				 baseForm.Width, _
				 Screen.PrimaryScreen.Bounds.Height - pos.Y - 50, _
				 1 _
				)

				ShowWindow(curHandle, SW_RESTORE)
				'baseForm.Activate()

			End If
		Catch ex As Exception
			TabControl.TabPages.Remove(Me)
		End Try

	End Sub

	Public Sub Change()

		Try
			If Not curObject.Busy Then
				Dim str As String = curObject.Document.title.ToString()
				If str.Length > 10 Then
					Me.Text = str.Substring(0, 10)
				Else
					Me.Text = str
				End If

			End If
		Catch ex As Exception
			TabControl.TabPages.Remove(Me)
		End Try

	End Sub

	Private Sub inner_DocumentComplete( _
	 ByVal pDisp As Object, _
	 ByRef URL As Object)

		' あちら側からの呼び出し
		Dim Bridge As New ProcBridge(AddressOf ThisProcBridge)
		Dim ret As Integer = _
		 CInt(Me.Invoke(Bridge, New Object() {pDisp.Document.title}))

#If DEBUG Then
		Dim str As String = pDisp.Document.title + ":" + URL.ToString()
		Console.WriteLine("DocumentComplete:" + str)
#End If
	End Sub

	Private Sub inner_BeforeNavigate2( _
	  ByVal pDisp As Object, _
	  ByRef url As Object, _
	  ByRef Flags As Object, _
	  ByRef TargetFrameName As Object, _
	  ByRef PostData As Object, _
	  ByRef Headers As Object, _
	  ByRef Cancel As Boolean)
#If DEBUG Then
		Dim str As String = pDisp.Document.title + ":" + url.ToString()
		Console.WriteLine("BeforeNavigate2:" + str)
#End If
	End Sub

	Private Sub inner_NavigateComplete2( _
	  ByVal pDisp As Object, _
	  ByRef URL As Object)
#If DEBUG Then
		Dim str As String = pDisp.Document.title + ":" + URL.ToString()
		Console.WriteLine("NavigateComplete2:" + str)
#End If
	End Sub

End Class
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ