codice:
Imports System.Collections.Generic
Imports System.IO
Imports System.Linq
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.ComTypes
NotInheritable Class ShowSelectedInExplorer
Private Sub New()
End Sub
<Flags()> _
Private Enum SHCONT As UShort
SHCONTF_CHECKING_FOR_CHILDREN = &H10
SHCONTF_FOLDERS = &H20
SHCONTF_NONFOLDERS = &H40
SHCONTF_INCLUDEHIDDEN = &H80
SHCONTF_INIT_ON_FIRST_NEXT = &H100
SHCONTF_NETPRINTERSRCH = &H200
SHCONTF_SHAREABLE = &H400
SHCONTF_STORAGE = &H800
SHCONTF_NAVIGATION_ENUM = &H1000
SHCONTF_FASTITEMS = &H2000
SHCONTF_FLATLIST = &H4000
SHCONTF_ENABLE_ASYNC = &H8000
End Enum
<ComImport(), Guid("000214E6-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), ComConversionLoss()> _
Private Interface IShellFolder
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub ParseDisplayName(hwnd As IntPtr, <[In](), MarshalAs(UnmanagedType.[Interface])> pbc As IBindCtx, <[In](), MarshalAs(UnmanagedType.LPWStr)> pszDisplayName As String, <Out()> ByRef pchEaten As UInteger, <Out()> ByRef ppidl As IntPtr, <[In](), Out()> ByRef pdwAttributes As UInteger)
<PreserveSig()> _
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function EnumObjects(<[In]()> hwnd As IntPtr, <[In]()> grfFlags As SHCONT, <MarshalAs(UnmanagedType.[Interface])> ByRef ppenumIDList As IEnumIDList) As Integer
<PreserveSig()> _
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function BindToObject(<[In]()> pidl As IntPtr, <[In](), MarshalAs(UnmanagedType.[Interface])> pbc As IBindCtx, <[In]()> ByRef riid As Guid, <Out(), MarshalAs(UnmanagedType.[Interface])> ByRef ppv As IShellFolder) As Integer
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub BindToStorage(<[In]()> ByRef pidl As IntPtr, <[In](), MarshalAs(UnmanagedType.[Interface])> pbc As IBindCtx, <[In]()> ByRef riid As Guid, ByRef ppv As IntPtr)
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub CompareIDs(<[In]()> lParam As IntPtr, <[In]()> ByRef pidl1 As IntPtr, <[In]()> ByRef pidl2 As IntPtr)
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub CreateViewObject(<[In]()> hwndOwner As IntPtr, <[In]()> ByRef riid As Guid, ByRef ppv As IntPtr)
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub GetAttributesOf(<[In]()> cidl As UInteger, <[In]()> apidl As IntPtr, <[In](), Out()> ByRef rgfInOut As UInteger)
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub GetUIObjectOf(<[In]()> hwndOwner As IntPtr, <[In]()> cidl As UInteger, <[In]()> apidl As IntPtr, <[In]()> ByRef riid As Guid, <[In](), Out()> ByRef rgfReserved As UInteger, ByRef ppv As IntPtr)
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub GetDisplayNameOf(<[In]()> ByRef pidl As IntPtr, <[In]()> uFlags As UInteger, ByRef pName As IntPtr)
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Sub SetNameOf(<[In]()> hwnd As IntPtr, <[In]()> ByRef pidl As IntPtr, <[In](), MarshalAs(UnmanagedType.LPWStr)> pszName As String, <[In]()> uFlags As UInteger, <Out()> ppidlOut As IntPtr)
End Interface
<ComImport(), Guid("000214F2-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Private Interface IEnumIDList
<PreserveSig()> _
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function [Next](celt As UInteger, rgelt As IntPtr, ByRef pceltFetched As UInteger) As Integer
<PreserveSig()> _
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function Skip(<[In]()> celt As UInteger) As Integer
<PreserveSig()> _
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function Reset() As Integer
<PreserveSig()> _
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function Clone(<MarshalAs(UnmanagedType.[Interface])> ByRef ppenum As IEnumIDList) As Integer
End Interface
Private Class NativeMethods
<DllImport("ole32.dll", EntryPoint:="CreateBindCtx")> _
Public Shared Function CreateBindCtx_(reserved As Integer, ByRef ppbc As IBindCtx) As Integer
End Function
Public Shared Function CreateBindCtx() As IBindCtx
Dim result As IBindCtx
Marshal.ThrowExceptionForHR(CreateBindCtx_(0, result))
Return result
End Function
<DllImport("shell32.dll", EntryPoint:="SHGetDesktopFolder", CharSet:=CharSet.Unicode, SetLastError:=True)> _
Private Shared Function SHGetDesktopFolder_(<MarshalAs(UnmanagedType.[Interface])> ByRef ppshf As IShellFolder) As Integer
End Function
Public Shared Function SHGetDesktopFolder() As IShellFolder
Dim result As IShellFolder
Marshal.ThrowExceptionForHR(SHGetDesktopFolder_(result))
Return result
End Function
<DllImport("shell32.dll", EntryPoint:="SHOpenFolderAndSelectItems")> _
Private Shared Function SHOpenFolderAndSelectItems_(<[In]()> pidlFolder As IntPtr, cidl As UInteger, <[In](), [Optional](), MarshalAs(UnmanagedType.LPArray)> apidl As IntPtr(), dwFlags As Integer) As Integer
End Function
Public Shared Sub SHOpenFolderAndSelectItems(pidlFolder As IntPtr, apidl As IntPtr(), dwFlags As Integer)
Dim cidl = If((apidl IsNot Nothing), CUInt(apidl.Length), 0UI)
Dim result = NativeMethods.SHOpenFolderAndSelectItems_(pidlFolder, cidl, apidl, dwFlags)
Marshal.ThrowExceptionForHR(result)
End Sub
<DllImport("shell32.dll", CharSet:=CharSet.Unicode)> _
Public Shared Function ILCreateFromPath(<[In](), MarshalAs(UnmanagedType.LPWStr)> pszPath As String) As IntPtr
End Function
<DllImport("shell32.dll")> _
Public Shared Sub ILFree(<[In]()> pidl As IntPtr)
End Sub
End Class
Private Shared Function GetShellFolderChildrenRelativePIDL(parentFolder As IShellFolder, displayName As String) As IntPtr
Dim bindCtx = NativeMethods.CreateBindCtx()
Dim pchEaten As UInteger
Dim pdwAttributes As UInteger = 0
Dim ppidl As IntPtr
parentFolder.ParseDisplayName(IntPtr.Zero, Nothing, displayName, pchEaten, ppidl, pdwAttributes)
Return ppidl
End Function
Private Shared Function PathToAbsolutePIDL(path As String) As IntPtr
Dim desktopFolder = NativeMethods.SHGetDesktopFolder()
Return GetShellFolderChildrenRelativePIDL(desktopFolder, path)
End Function
Shared IID_IShellFolder As Guid = GetType(IShellFolder).GUID
Shared pointerSize As Integer = Marshal.SizeOf(GetType(IntPtr))
Private Shared Function PIDLToShellFolder(parent As IShellFolder, pidl As IntPtr) As IShellFolder
Dim folder As IShellFolder
Dim result = parent.BindToObject(pidl, Nothing, IID_IShellFolder, folder)
Marshal.ThrowExceptionForHR(CInt(result))
Return folder
End Function
Private Shared Function PIDLToShellFolder(pidl As IntPtr) As IShellFolder
Return PIDLToShellFolder(NativeMethods.SHGetDesktopFolder(), pidl)
End Function
Private Shared Sub SHOpenFolderAndSelectItems(pidlFolder As IntPtr, apidl As IntPtr(), edit As Boolean)
NativeMethods.SHOpenFolderAndSelectItems(pidlFolder, apidl, If(edit, 1, 0))
End Sub
Public Shared Sub FileOrFolder(path As String, Optional edit As Boolean = False)
If path Is Nothing Then
Throw New ArgumentNullException("path")
End If
Dim pidl = PathToAbsolutePIDL(path)
Try
SHOpenFolderAndSelectItems(pidl, Nothing, edit)
Finally
NativeMethods.ILFree(pidl)
End Try
End Sub
Private Shared Function PathToFileSystemInfo(paths As IEnumerable(Of String)) As IEnumerable(Of FileSystemInfo)
Dim rect As List(Of FileSystemInfo) = New List(Of FileSystemInfo)
For Each path__1 In paths
Dim fixedPath As String = path__1
If fixedPath.EndsWith(Path.DirectorySeparatorChar.ToString()) OrElse fixedPath.EndsWith(Path.AltDirectorySeparatorChar.ToString()) Then
fixedPath = fixedPath.Remove(fixedPath.Length - 1)
End If
If Directory.Exists(fixedPath) Then
rect.Add(New DirectoryInfo(fixedPath))
ElseIf File.Exists(fixedPath) Then
rect.Add(New FileInfo(fixedPath))
Else
Throw New FileNotFoundException("The specified file or folder doesn't exists : " & fixedPath, fixedPath)
End If
Next
Return rect
End Function
Public Shared Sub FilesOrFolders(parentDirectory As String, filenames As ICollection(Of String))
If filenames Is Nothing Then
Throw New ArgumentNullException("filenames")
End If
If filenames.Count = 0 Then
Return
End If
Dim parentPidl = PathToAbsolutePIDL(parentDirectory)
Try
Dim parent = PIDLToShellFolder(parentPidl)
Dim filesPidl As New List(Of IntPtr)(filenames.Count)
For Each filename In filenames
filesPidl.Add(GetShellFolderChildrenRelativePIDL(parent, filename))
Next
Try
SHOpenFolderAndSelectItems(parentPidl, filesPidl.ToArray(), False)
Finally
For Each pidl In filesPidl
NativeMethods.ILFree(pidl)
Next
End Try
Finally
NativeMethods.ILFree(parentPidl)
End Try
End Sub
Public Shared Sub FilesOrFolders(ParamArray paths As String())
FilesOrFolders(DirectCast(paths, IEnumerable(Of String)))
End Sub
Public Shared Sub FilesOrFolders(paths As IEnumerable(Of String))
FilesOrFolders(PathToFileSystemInfo(paths))
End Sub
Public Shared Sub FilesOrFolders(paths As IEnumerable(Of FileSystemInfo))
If paths Is Nothing Then
Throw New ArgumentNullException("paths")
End If
If paths.Count() = 0 Then
Return
End If
Dim explorerWindows = paths.GroupBy(Function(p) Path.GetDirectoryName(p.FullName))
For Each explorerWindowPaths In explorerWindows
Dim parentDirectory = Path.GetDirectoryName(explorerWindowPaths.First().FullName)
FilesOrFolders(parentDirectory, explorerWindowPaths.[Select](Function(fsi) fsi.Name).ToList())
Next
End Sub
End Class
e si usa così :