Benshi/wankuma95803.vb

## wankuma95803.vb
Option Explicit On
Option Strict On
Imports SHDocVw     '参照設定(COM)：Microsoft Internet Controls
Imports Shell32     '参照設定(COM)：Microsoft Shell Controls And Automation
'Imports mshtml     '参照設定(COM)：Microsoft HTML Object Library
Imports System.IO
Imports System.Runtime.InteropServices

'コントロールを 2 つ貼っておく
'　Button1
'　TextBox1 … Multiline = True, Scrollbars = Both, WordWrap = False
Public Class Form1

    ' https://docs.microsoft.com/ja-jp/windows/win32/api/shobjidl_core/ne-shobjidl_core-_svsif?WT.mc_id=DT-MVP-8907
    <Flags>
    Private Enum SVSIF As Integer
        Deselect = &H0
        [Select] = &H1
        Edit = &H3
        DeselectOthers = &H4
        EnsureVisible = &H8
        Focused = &H10
        TranslatePt = &H20
        SelectionMark = &H40
        PositionItem = &H80
        Check = &H100
        Check2 = &H200
        KeyboardSelect = &H401
        NoTakeFocus = &H40000000
    End Enum

    'COM オブジェクトの解放用メソッド
    Private Sub ReleaseComObject(Of T)(ByRef o As T)
        If o IsNot Nothing AndAlso Marshal.IsComObject(o) Then
            Marshal.ReleaseComObject(o)
            o = Nothing
        End If
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        TextBox1.Clear()

        'ShellWindows オブジェクトを作成します。
        '(Shell32.Shell オブジェクトの Windows メソッドで生成する方法もあります)
        Dim shellWindows = DirectCast(GetObject("new:9BA05972-F6A8-11CF-A442-00A0C90A8F39"), IShellWindows)
        Dim _NewEnum = CallByName(shellWindows, "[DispId=-4]", CallType.Method)
        Try
            ' For Each で列挙しても良いのですが、その場合、
            ' IEnumVARIANT を明示的に解放できなくなるので、
            ' ここでは While ループで処理するようにしています。
            Dim enumerator = DirectCast(_NewEnum, IEnumerator)
            While enumerator.MoveNext()
                TextBox1.AppendText(StrDup(40, "＝"c) & vbCrLf)

                'エクスプローラー と Internet Explorer が順に列挙されます。
                Dim current = enumerator.Current

                ' エクスプローラー と Internet Explorer の区別には、FullName プロパティが使えます。
                ' (FullName が explorer.exe / iexplore.exe のいずれを返すのかを確認する)
                Dim exp = DirectCast(current, IWebBrowser2)
                TextBox1.AppendText(Path.GetFileName(exp.FullName).ToLowerInvariant() & vbCrLf)
                TextBox1.AppendText($"実行= ""{exp.FullName}""{vbCrLf}")
                TextBox1.AppendText($"位置= {New Rectangle(exp.Left, exp.Top, exp.Width, exp.Height).ToString()}{vbCrLf}")
                TextBox1.AppendText($"場所= ""{exp.LocationName}""{vbCrLf}")
                TextBox1.AppendText($"URL = ""{exp.LocationURL}""{vbCrLf}")

                ' 殆どの場合は FullName での判定で事足りるとは思いますが、環境によっては、
                ' iexplore.exe で、Web ページだけでなくフォルダーや PDF を開いたり、
                ' explorer.exe で、フォルダーだけでなく Web ページを表示できることもあります。
                '
                ' もしも IE でフォルダーが開かれていた場合も選択処理したいのであれば、
                ' FullName で判定する代わりに、Document プロパティから実際に返されてきた
                ' オブジェクトの型で判定することができます。

                TextBox1.AppendText(StrDup(40, "－"c) & vbCrLf)
                Dim doc As Object = Nothing

                Dim oFocusedItem As FolderItem = Nothing
                Dim oSelectedItems As FolderItems = Nothing
                Dim oFolder As Folder = Nothing
                Dim oFolderItems As FolderItems = Nothing
                Try
                    ' Document プロパティの型を判定するために、Object 型変数に受けておきます。
                    ' 今回のケースでは、ShellFolderView 型かどうかをチェックすればよいでしょう。
                    doc = exp.Document

                    'Dim html As HTMLDocument = Nothing
                    Dim fv0 As ShellFolderView = Nothing
                    ''Dim fv1 As IShellFolderViewDual = Nothing
                    ''Dim fv2 As IShellFolderViewDual2 = Nothing
                    ''Dim fv3 As IShellFolderViewDual3 = Nothing

                    fv0 = TryCast(doc, Shell32.ShellFolderView)
                    If fv0 IsNot Nothing Then
                        ' 蛇足ではあるけれども、ついでに各種情報を取得してみます。
                        TextBox1.AppendText("ShellFolderView が取得されました。" & vbCrLf)
                        TextBox1.AppendText($"  .IconSize = {fv0.IconSize}{vbCrLf}")
                        TextBox1.AppendText($"  .GroupBy = ""{fv0.GroupBy}""{vbCrLf}")
                        TextBox1.AppendText($"  .SortColumns = ""{fv0.SortColumns}""{vbCrLf}")
                        TextBox1.AppendText($"  .CurrentViewMode = {DirectCast(fv0.CurrentViewMode, FolderViewMode)}{vbCrLf}")
                        TextBox1.AppendText($"  .FolderFlags = {DirectCast(fv0.FolderFlags, FolderFlags)}UI{vbCrLf}")
                        TextBox1.AppendText($"  .ViewOptions = {DirectCast(fv0.ViewOptions, ShellFolderViewOptions)}{vbCrLf}")

                        oFocusedItem = fv0.FocusedItem
                        If oFocusedItem Is Nothing Then
                            TextBox1.AppendText("  .FocusedItem は Nothing です。" & vbCrLf)
                        Else
                            TextBox1.AppendText($"  .FocusedItem.Name = ""{oFocusedItem.Name}""{vbCrLf}")
                            TextBox1.AppendText($"  .FocusedItem.Path = ""{oFocusedItem.Path}""{vbCrLf}")
                            TextBox1.AppendText($"  .FocusedItem.IsFileSystem = {oFocusedItem.IsFileSystem}{vbCrLf}")
                            TextBox1.AppendText($"  .FocusedItem.IsFolder = {oFocusedItem.IsFolder}{vbCrLf}")
                            ReleaseComObject(oFocusedItem)
                        End If


                        oFolder = fv0.Folder
                        TextBox1.AppendText($"  .Folder.Title = ""{oFolder.Title}""{vbCrLf}")

                        oFolderItems = oFolder.Items()
                        TextBox1.AppendText($"  .Folder.Items.Count = {oFolderItems.Count}{vbCrLf}")

                        oSelectedItems = fv0.SelectedItems
                        TextBox1.AppendText($"  .SelectedItems.Count = {oSelectedItems.Count}{vbCrLf}")
                        ReleaseComObject(oSelectedItems)

                        TextBox1.AppendText("   ==> すべての[ファイル]を選択状態にします。" & vbCrLf)

                        Dim item As Object = DBNull.Value
                        fv0.SelectItem(item, SVSIF.DeselectOthers)  '選択解除

                        'フォルダー内のアイテムを列挙し、ファイルだけを選んで選択していきます。
                        For n = 0 To oFolderItems.Count - 1
                            Dim fi As Shell32.FolderItem = oFolderItems.Item(n)
                            '「If Not fi.IsFolder Then」で判定した場合、
                            ' zip ファイルがフォルダーとして扱われる可能性があるので、
                            ' System.IO.File.Exists の方が確実です。
                            If fi.IsFileSystem AndAlso File.Exists(fi.Path) Then
                                TextBox1.AppendText($"     [*] {fi.Name}({fi.Path}){vbCrLf}")
                                item = fi
                                ' ★これが本題★
                                fv0.SelectItem(item, SVSIF.Select)
                                'fv0.SelectItem(item, SVSIF.Select Or SVSIF.EnsureVisible)
                                item = Nothing
                            Else
                                ' ただし File.Exists による判定方法では、実在ファイルしかチェックできないため、
                                ' フォルダー内にあるファイルが、実際には存在していない、選択できないことになります。
                                '(たとえば、[クイック アクセス]フォルダーの[最近使用したファイル]など)
                                TextBox1.AppendText($"     [_] {fi.Name}({fi.Path}){vbCrLf}")
                            End If
                            ReleaseComObject(fi)
                        Next
                        ReleaseComObject(oFolderItems)

                        TextBox1.AppendText("   <== 選択終了。現在の選択数は…" & vbCrLf)
                        oSelectedItems = fv0.SelectedItems
                        TextBox1.AppendText($"  .SelectedItems.Count = {oSelectedItems.Count}{vbCrLf}")
                        ReleaseComObject(oSelectedItems)
                    Else
                        TextBox1.AppendText("ShellFolderView ではありません。" & vbCrLf)
                    End If
                Catch ex As Exception
                    TextBox1.AppendText("エラーが発生しました。" & vbCrLf)
                    TextBox1.AppendText(ex.ToString() & vbCrLf)
                Finally
                    ReleaseComObject(oFolderItems)
                    ReleaseComObject(oFolder)
                    ReleaseComObject(oSelectedItems)
                    ReleaseComObject(oFocusedItem)
                    ReleaseComObject(doc)
                    ReleaseComObject(current)
                End Try
            End While
        Catch
        Finally
            Marshal.ReleaseComObject(DirectCast(_NewEnum, ICustomAdapter).GetUnderlyingObject())
        End Try
        Marshal.ReleaseComObject(shellWindows)
        TextBox1.AppendText(StrDup(40, "＝"c) & vbCrLf)
        TextBox1.AppendText("列挙が終了しました。")
    End Sub

    Private Enum FolderViewMode As UInteger
        Icon = 1
        SmallIcon = 2
        List = 3
        Details = 4
        Thumbnail = 5
        Tile = 6
        ThumbStrip = 7
        Contents = 8
    End Enum

    <Flags>
    Private Enum FolderFlags As UInteger
        None = &H0
        AutoArrange = &H1
        AbbreviatedNames = &H2
        SnapToGrid = &H4
        OwnerData = &H8
        BestFitWindow = &H10
        Desktop = &H20
        SingleSel = &H40
        NoSubFolders = &H80
        Transparent = &H100
        NoClientEdge = &H200
        NoScroll = &H400
        AlignLeft = &H800
        NoIcons = &H1000
        ShowSelAlways = &H2000
        NoVisible = &H4000
        SingleClickActivate = &H8000
        NoWebView = &H10000
        HideFileNames = &H20000
        CheckSelect = &H40000
        NoEnumRefresh = &H80000
        NoGrouping = &H100000
        FullRowSelect = &H200000
        NoFilters = &H400000
        NoColumnHeader = &H800000
        NoHeaderInAllViews = &H1000000
        ExtendedTiles = &H2000000
        TriCheckSelect = &H4000000
        AutoCheckSelect = &H8000000
        NoBrowserViewState = &H10000000
        SubsetGroups = &H20000000
        UseSearchFolder = &H40000000
        AllowRtlReading = &H80000000UI
    End Enum

    <Flags>
    Public Enum ShellFolderViewOptions
        ShowAllObjects = &H1
        ShowExtensions = &H2
        ShowCompColor = &H8
        ShowSysFiles = &H20
        Win95Classic = &H40
        DoubleClickInWebView = &H80
        DesktopHtml = &H200
    End Enum
End Class
	Option Explicit On
	Option Strict On
	Imports SHDocVw '参照設定(COM)：Microsoft Internet Controls
	Imports Shell32 '参照設定(COM)：Microsoft Shell Controls And Automation
	'Imports mshtml '参照設定(COM)：Microsoft HTML Object Library
	Imports System.IO
	Imports System.Runtime.InteropServices

	'コントロールを 2 つ貼っておく
	'　Button1
	'　TextBox1 … Multiline = True, Scrollbars = Both, WordWrap = False
	Public Class Form1

	' https://docs.microsoft.com/ja-jp/windows/win32/api/shobjidl_core/ne-shobjidl_core-_svsif?WT.mc_id=DT-MVP-8907
	<Flags>
	Private Enum SVSIF As Integer
	Deselect = &H0
	[Select] = &H1
	Edit = &H3
	DeselectOthers = &H4
	EnsureVisible = &H8
	Focused = &H10
	TranslatePt = &H20
	SelectionMark = &H40
	PositionItem = &H80
	Check = &H100
	Check2 = &H200
	KeyboardSelect = &H401
	NoTakeFocus = &H40000000
	End Enum

	'COM オブジェクトの解放用メソッド
	Private Sub ReleaseComObject(Of T)(ByRef o As T)
	If o IsNot Nothing AndAlso Marshal.IsComObject(o) Then
	Marshal.ReleaseComObject(o)
	o = Nothing
	End If
	End Sub
	Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
	TextBox1.Clear()

	'ShellWindows オブジェクトを作成します。
	'(Shell32.Shell オブジェクトの Windows メソッドで生成する方法もあります)
	Dim shellWindows = DirectCast(GetObject("new:9BA05972-F6A8-11CF-A442-00A0C90A8F39"), IShellWindows)
	Dim _NewEnum = CallByName(shellWindows, "[DispId=-4]", CallType.Method)
	Try
	' For Each で列挙しても良いのですが、その場合、
	' IEnumVARIANT を明示的に解放できなくなるので、
	' ここでは While ループで処理するようにしています。
	Dim enumerator = DirectCast(_NewEnum, IEnumerator)
	While enumerator.MoveNext()
	TextBox1.AppendText(StrDup(40, "＝"c) & vbCrLf)

	'エクスプローラーと Internet Explorer が順に列挙されます。
	Dim current = enumerator.Current

	' エクスプローラーと Internet Explorer の区別には、FullName プロパティが使えます。
	' (FullName が explorer.exe / iexplore.exe のいずれを返すのかを確認する)
	Dim exp = DirectCast(current, IWebBrowser2)
	TextBox1.AppendText(Path.GetFileName(exp.FullName).ToLowerInvariant() & vbCrLf)
	TextBox1.AppendText($"実行= ""{exp.FullName}""{vbCrLf}")
	TextBox1.AppendText($"位置= {New Rectangle(exp.Left, exp.Top, exp.Width, exp.Height).ToString()}{vbCrLf}")
	TextBox1.AppendText($"場所= ""{exp.LocationName}""{vbCrLf}")
	TextBox1.AppendText($"URL = ""{exp.LocationURL}""{vbCrLf}")

	' 殆どの場合は FullName での判定で事足りるとは思いますが、環境によっては、
	' iexplore.exe で、Web ページだけでなくフォルダーや PDF を開いたり、
	' explorer.exe で、フォルダーだけでなく Web ページを表示できることもあります。
	'
	' もしも IE でフォルダーが開かれていた場合も選択処理したいのであれば、
	' FullName で判定する代わりに、Document プロパティから実際に返されてきた
	' オブジェクトの型で判定することができます。

	TextBox1.AppendText(StrDup(40, "－"c) & vbCrLf)
	Dim doc As Object = Nothing

	Dim oFocusedItem As FolderItem = Nothing
	Dim oSelectedItems As FolderItems = Nothing
	Dim oFolder As Folder = Nothing
	Dim oFolderItems As FolderItems = Nothing
	Try
	' Document プロパティの型を判定するために、Object 型変数に受けておきます。
	' 今回のケースでは、ShellFolderView 型かどうかをチェックすればよいでしょう。
	doc = exp.Document

	'Dim html As HTMLDocument = Nothing
	Dim fv0 As ShellFolderView = Nothing
	''Dim fv1 As IShellFolderViewDual = Nothing
	''Dim fv2 As IShellFolderViewDual2 = Nothing
	''Dim fv3 As IShellFolderViewDual3 = Nothing

	fv0 = TryCast(doc, Shell32.ShellFolderView)
	If fv0 IsNot Nothing Then
	' 蛇足ではあるけれども、ついでに各種情報を取得してみます。
	TextBox1.AppendText("ShellFolderView が取得されました。" & vbCrLf)
	TextBox1.AppendText($" .IconSize = {fv0.IconSize}{vbCrLf}")
	TextBox1.AppendText($" .GroupBy = ""{fv0.GroupBy}""{vbCrLf}")
	TextBox1.AppendText($" .SortColumns = ""{fv0.SortColumns}""{vbCrLf}")
	TextBox1.AppendText($" .CurrentViewMode = {DirectCast(fv0.CurrentViewMode, FolderViewMode)}{vbCrLf}")
	TextBox1.AppendText($" .FolderFlags = {DirectCast(fv0.FolderFlags, FolderFlags)}UI{vbCrLf}")
	TextBox1.AppendText($" .ViewOptions = {DirectCast(fv0.ViewOptions, ShellFolderViewOptions)}{vbCrLf}")

	oFocusedItem = fv0.FocusedItem
	If oFocusedItem Is Nothing Then
	TextBox1.AppendText(" .FocusedItem は Nothing です。" & vbCrLf)
	Else
	TextBox1.AppendText($" .FocusedItem.Name = ""{oFocusedItem.Name}""{vbCrLf}")
	TextBox1.AppendText($" .FocusedItem.Path = ""{oFocusedItem.Path}""{vbCrLf}")
	TextBox1.AppendText($" .FocusedItem.IsFileSystem = {oFocusedItem.IsFileSystem}{vbCrLf}")
	TextBox1.AppendText($" .FocusedItem.IsFolder = {oFocusedItem.IsFolder}{vbCrLf}")
	ReleaseComObject(oFocusedItem)
	End If


	oFolder = fv0.Folder
	TextBox1.AppendText($" .Folder.Title = ""{oFolder.Title}""{vbCrLf}")

	oFolderItems = oFolder.Items()
	TextBox1.AppendText($" .Folder.Items.Count = {oFolderItems.Count}{vbCrLf}")

	oSelectedItems = fv0.SelectedItems
	TextBox1.AppendText($" .SelectedItems.Count = {oSelectedItems.Count}{vbCrLf}")
	ReleaseComObject(oSelectedItems)

	TextBox1.AppendText(" ==> すべての[ファイル]を選択状態にします。" & vbCrLf)

	Dim item As Object = DBNull.Value
	fv0.SelectItem(item, SVSIF.DeselectOthers) '選択解除

	'フォルダー内のアイテムを列挙し、ファイルだけを選んで選択していきます。
	For n = 0 To oFolderItems.Count - 1
	Dim fi As Shell32.FolderItem = oFolderItems.Item(n)
	'「If Not fi.IsFolder Then」で判定した場合、
	' zip ファイルがフォルダーとして扱われる可能性があるので、
	' System.IO.File.Exists の方が確実です。
	If fi.IsFileSystem AndAlso File.Exists(fi.Path) Then
	TextBox1.AppendText($" [*] {fi.Name}({fi.Path}){vbCrLf}")
	item = fi
	' ★これが本題★
	fv0.SelectItem(item, SVSIF.Select)
	'fv0.SelectItem(item, SVSIF.Select Or SVSIF.EnsureVisible)
	item = Nothing
	Else
	' ただし File.Exists による判定方法では、実在ファイルしかチェックできないため、
	' フォルダー内にあるファイルが、実際には存在していない、選択できないことになります。
	'(たとえば、[クイックアクセス]フォルダーの[最近使用したファイル]など)
	TextBox1.AppendText($" [_] {fi.Name}({fi.Path}){vbCrLf}")
	End If
	ReleaseComObject(fi)
	Next
	ReleaseComObject(oFolderItems)

	TextBox1.AppendText(" <== 選択終了。現在の選択数は…" & vbCrLf)
	oSelectedItems = fv0.SelectedItems
	TextBox1.AppendText($" .SelectedItems.Count = {oSelectedItems.Count}{vbCrLf}")
	ReleaseComObject(oSelectedItems)
	Else
	TextBox1.AppendText("ShellFolderView ではありません。" & vbCrLf)
	End If
	Catch ex As Exception
	TextBox1.AppendText("エラーが発生しました。" & vbCrLf)
	TextBox1.AppendText(ex.ToString() & vbCrLf)
	Finally
	ReleaseComObject(oFolderItems)
	ReleaseComObject(oFolder)
	ReleaseComObject(oSelectedItems)
	ReleaseComObject(oFocusedItem)
	ReleaseComObject(doc)
	ReleaseComObject(current)
	End Try
	End While
	Catch
	Finally
	Marshal.ReleaseComObject(DirectCast(_NewEnum, ICustomAdapter).GetUnderlyingObject())
	End Try
	Marshal.ReleaseComObject(shellWindows)
	TextBox1.AppendText(StrDup(40, "＝"c) & vbCrLf)
	TextBox1.AppendText("列挙が終了しました。")
	End Sub

	Private Enum FolderViewMode As UInteger
	Icon = 1
	SmallIcon = 2
	List = 3
	Details = 4
	Thumbnail = 5
	Tile = 6
	ThumbStrip = 7
	Contents = 8
	End Enum

	<Flags>
	Private Enum FolderFlags As UInteger
	None = &H0
	AutoArrange = &H1
	AbbreviatedNames = &H2
	SnapToGrid = &H4
	OwnerData = &H8
	BestFitWindow = &H10
	Desktop = &H20
	SingleSel = &H40
	NoSubFolders = &H80
	Transparent = &H100
	NoClientEdge = &H200
	NoScroll = &H400
	AlignLeft = &H800
	NoIcons = &H1000
	ShowSelAlways = &H2000
	NoVisible = &H4000
	SingleClickActivate = &H8000
	NoWebView = &H10000
	HideFileNames = &H20000
	CheckSelect = &H40000
	NoEnumRefresh = &H80000
	NoGrouping = &H100000
	FullRowSelect = &H200000
	NoFilters = &H400000
	NoColumnHeader = &H800000
	NoHeaderInAllViews = &H1000000
	ExtendedTiles = &H2000000
	TriCheckSelect = &H4000000
	AutoCheckSelect = &H8000000
	NoBrowserViewState = &H10000000
	SubsetGroups = &H20000000
	UseSearchFolder = &H40000000
	AllowRtlReading = &H80000000UI
	End Enum

	<Flags>
	Public Enum ShellFolderViewOptions
	ShowAllObjects = &H1
	ShowExtensions = &H2
	ShowCompColor = &H8
	ShowSysFiles = &H20
	Win95Classic = &H40
	DoubleClickInWebView = &H80
	DesktopHtml = &H200
	End Enum
	End Class