エクスプローラ キャプチャー


  Shell32 ( COM ) と Windows API



画面が少しちらつくの気にいらないのですが、一応使えるはずです。
フォームにタブコントロールを貼っただけ。

現在実行中のエクスプローラを捕獲します。
( IE も捕獲できるはずなんですが、いまのところ必要無いので )

終了時に最後に捕獲したエクスプローラを次の起動で再現できれば
もっといい感じになるでしょう
( 二重起動も止めないと )



  コード






  

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 Sub Form1_Load(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.Load

		Dim obj As New Shell32.Shell()

		For Each obj2 As Object In obj.Windows

			If "System.__ComObject" = obj2.Document.ToString() Then

				Dim curDir As String = obj2.Document.Folder.Self.Path
				curDir = System.IO.Path.GetFileName(curDir)

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

			End If

		Next

		Try

			HideTabPage()
			Me.TabControl1.SelectTab(0)
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()

		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)

		Try
			CType(TabControl1.SelectedTab, LboxTabPage).Change()
		Catch ex As Exception
		End Try

		Dim obj As New Shell32.Shell()

		For Each obj2 As Object In obj.Windows

			If "System.__ComObject" = obj2.Document.ToString() Then

				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 curDir As String = obj2.Document.Folder.Self.Path
					curDir = System.IO.Path.GetFileName(curDir)

					Dim page As New LboxTabPage( _
					 Me, _
					 curDir, _
					 obj2.HWND(), _
					 TabControl1, _
					 obj2 _
					 )
					Me.TabControl1.TabPages.Add(page)
					page.HideDir()
				End If

			End If

		Next

	End Sub

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

		CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		HideTabPage()

	End Sub


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

		Try
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
			HideTabPage()
		Catch ex As Exception

		End Try

	End Sub

	' ***************************************************************
	' 最小化された時
	' ***************************************************************
	Private Sub Form1_Resize(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.Resize

		If Me.WindowState = FormWindowState.Minimized Then
			Try
				HideTabPage()
				ShowWindow( _
				 CType(TabControl1.SelectedTab, LboxTabPage).curHandle, _
				 SW_HIDE)
			Catch ex As Exception

			End Try
		End If

	End Sub

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

		CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		HideTabPage()

	End Sub

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

		timer.Enabled = False

		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)
			CurPage.ShowDir()
		Next

	End Sub

	' ***************************************************************
	' 全て非表示
	' ***************************************************************
	Private Sub HideTabPage()

		Dim PageCount As Integer = TabControl1.TabPages.Count
		Dim CurPage As LboxTabPage = Nothing
		For I As Integer = 0 To PageCount - 1
			CurPage = TabControl1.TabPages(I)
			CurPage.HideDir()
		Next

	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 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

		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)

			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_SHOW)
			baseForm.Activate()

		End Sub

		Public Sub HideDir()

			If CType(TabControl.SelectedTab, LboxTabPage).curHandle <> Me.curHandle Then

				Try

					ShowWindow(Me.curHandle, SW_HIDE)

					Dim base As New System.Drawing.Point( _
					 -5, _
					 baseForm.ClientSize.Height + 5 _
					 )
					Dim pos As System.Drawing.Point = Me.PointToScreen(base)

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

					Dim curDir As String = curObject.Document.Folder.Self.Path
					Me.Text = System.IO.Path.GetFileName(curDir)

				Catch ex As Exception

				End Try

			End If

		End Sub

		Public Sub ShowDir()

			Try

				ShowWindow(Me.curHandle, SW_SHOW)

			Catch ex As Exception

			End Try

		End Sub

		Public Sub Change()

			Try

				Dim curDir As String = curObject.Document.Folder.Self.Path
				Me.Text = System.IO.Path.GetFileName(curDir)

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

		End Sub

	End Class

End Class
  




yahoo  google  MSDN  MSDN(us)  WinFAQ  Win Howto  tohoho  ie_DHTML  vector  wdic  辞書  天気 


[dnettool]
Mozilla/5.0 AppleWebKit/537.36 (KHTML, like Gecko; compatible; ClaudeBot/1.0; +claudebot@anthropic.com)
24/04/20 17:20:42
InfoBoard Version 1.00 : Language=Perl

1 BatchHelper COMprog CommonSpec Cprog CprogBase CprogSAMPLE CprogSTD CprogSTD2 CprogWinsock Cygwin GameScript HTML HTMLcss InstallShield InstallShieldFunc JScript JScriptSAMPLE Jsfuncs LLINK OldProg OracleGold OracleSilver PRO PRObrowser PROc PROconePOINT PROcontrol PROftpclient PROjscript PROmailer PROperl PROperlCHAT PROphp PROphpLesson PROphpLesson2 PROphpLesson3 PROphpfunction PROphpfunctionArray PROphpfunctionMisc PROphpfunctionString PROsql PROvb PROvbFunction PROvbString PROvbdbmtn PROvbonepoint PROwebapp PROwin1POINT PROwinSYSTEM PROwinYOROZU PROwindows ProjectBoard RealPHP ScriptAPP ScriptMaster VBRealtime Vsfuncs a1root access accreq adsi ajax amazon argus asp aspSample aspVarious aspdotnet aw2kinst cappvariety centura ckeyword classStyle cmaterial cmbin cmdbapp cmenum cmlang cmlistbox cmstd cmstdseed cmtxt cs daz3d db dbCommon dbaccess dnettool dos download flex2 flex3 flex4 framemtn framereq freeWorld freesoft gimp ginpro giodownload google hdml home hta htmlDom ie9svg install java javaSwing javascript jetsql jquery jsp jspTest jspVarious lightbox listasp listmsapi listmsie listmsiis listmsnt listmspatch listmsscript listmsvb listmsvc memo ms msde mysql netbeans oraPlsql oracle oracleWiper oraclehelper orafunc other panoramio pear perl personal pgdojo pgdojo_cal pgdojo_holiday pgdojo_idx pgdojo_ref pgdojo_req php phpVarious phpguide plsql postgres ps r205 realC realwebapp regex rgaki ruby rule sboard sc scprint scquest sdb sdbquest seesaa setup sh_Imagick sh_canvas sh_dotnet sh_google sh_tool sh_web shadowbox shgm shjquery shvbs shweb sjscript skadai skywalker smalltech sperl sqlq src systemdoc tcpip tegaki three toolbox twitter typeface usb useXML vb vbdb vbsfunc vbsguide vbsrc vpc wcsignup webanymind webappgen webclass webparts webtool webwsh win8 winofsql wmi work wp youtube