抱歉,原作者忘记地址了,是从C#代码转换过来的。留这里做一个记号。
代码
Imports
System.Runtime.InteropServices
Imports System.Text
Module Module1
Public Declare Function SHOpenFolderAndSelectItems Lib " shell32.dll " ( ByVal pidlFolder As IntPtr, ByVal cidl As UInteger , < [ In ](), MarshalAs(UnmanagedType.LPArray) > ByVal apidll As IntPtr(), ByVal dwFlags As UInteger ) As Integer
Public Declare Function CoCreateInstance Lib " ole32.dll " ( < [ In ]() > ByRef rclsid As Guid, ByVal pUnkOuter As IntPtr, ByVal dwClsContext As CLSCTX, < [ In ]() > ByRef riid As Guid, < Out() > ByRef ppv As IntPtr) As Integer
Public Enum CLSCTX As UInteger
INPROC_SERVER = & H1
End Enum
Dim CLSID_ShellLink = New Guid( " 00021401-0000-0000-C000-000000000046 " )
Dim IID_IShellLink = New Guid( " 000214F9-0000-0000-C000-000000000046 " )
Sub SelectFile( ByVal filePath As String )
Dim ppsl = IntPtr.Zero
Dim result = CoCreateInstance(CLSID_ShellLink, IntPtr.Zero, CLSCTX.INPROC_SERVER, IID_IShellLink, ppsl)
Dim psl As IShellLinkW = Marshal.GetObjectForIUnknown(ppsl)
psl.SetPath(filePath)
Dim pidl = IntPtr.Zero
psl.GetIDList(pidl)
SHOpenFolderAndSelectItems(pidl, 0 , Nothing , 0 )
Marshal.FreeCoTaskMem(pidl)
Marshal.Release(ppsl)
End Sub
< Serializable(), StructLayout(LayoutKind.Sequential) > Public Structure FILETIME
Public dwLowDateTime As UInteger
Public dwHighDateTime As UInteger
End Structure
< Serializable(), StructLayout(LayoutKind.Sequential, CharSet: = CharSet.Unicode), BestFitMapping( False ) > _
Public Structure WIN32_FIND_DATAW
Public dwFileAttributes As UInteger
Public ftCreationTime As FILETIME
Public ftLastAccessTime As FILETIME
Public ftLastWriteTime As FILETIME
Public nFileSizeHigh As UInteger
Public nFileSizeLow As UInteger
Public dwReserved0 As UInteger
Public dwReserved1 As UInteger
< MarshalAs(UnmanagedType.ByValTStr, sizeConst: = 260 ) > Public cFileName As String
< MarshalAs(UnmanagedType.ByValTStr, sizeConst: = 14 ) > Public cAlternateFileName As String
End Structure
< ComImport(), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), Guid( " 000214F9-0000-0000-C000-000000000046 " ) > _
Public Interface IShellLinkW
< PreserveSig() > Function GetPath( ByVal pszFile As StringBuilder, ByVal cch As Integer , < [ In ](), Out() > ByRef pfd As WIN32_FIND_DATAW, ByVal fFlags As UInteger ) As Integer
< PreserveSig() > Function GetIDList( < Out() > ByRef ppidl As IntPtr) As Integer
< PreserveSig() > Function SetIDList( < [ In ]() > ByRef pidl As IntPtr) As Integer
< PreserveSig() > Function GetDescription( ByVal pszName As StringBuilder, ByVal cch As Integer ) As Integer
< PreserveSig() > Function SetDescription( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszName As String ) As Integer
< PreserveSig() > Function GetWorkingDirectory( ByVal pszDir As StringBuilder, ByVal cch As Integer ) As Integer
< PreserveSig() > Function SetWorkingDirectory( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszDir As String ) As Integer
< PreserveSig() > Function GetArguments( ByVal pszArgs As StringBuilder, ByVal cch As Integer ) As Integer
< PreserveSig() > Function SetArguments( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszArgs As String ) As Integer
< PreserveSig() > Function GetHotkey( < Out() > ByRef pwHotkey As UShort ) As Integer
< PreserveSig() > Function SetHotkey( ByVal wHotkey As UShort ) As Integer
< PreserveSig() > Function GetShowCmd( < Out() > ByRef piShowCmd As Integer ) As Integer
< PreserveSig() > Function SetShowCmd( ByVal iShowCmd As Integer ) As Integer
< PreserveSig() > Function GetIconLocation( ByVal pszIconPath As StringBuilder, ByVal cch As Integer , < Out() > ByRef piIcon As Integer ) As Integer
< PreserveSig() > Function SetIconLocation( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszIconPath As String , ByVal iIcon As Integer ) As Integer
< PreserveSig() > Function SetRelativePath( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszPathRel As String , ByVal dwReserved As UInteger ) As Integer
< PreserveSig() > Function Resolve( ByVal hwnd As IntPtr, ByVal fFlags As UInteger ) As Integer
< PreserveSig() > Function SetPath( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszFile As String ) As Integer
End Interface
End Module
Imports System.Text
Module Module1
Public Declare Function SHOpenFolderAndSelectItems Lib " shell32.dll " ( ByVal pidlFolder As IntPtr, ByVal cidl As UInteger , < [ In ](), MarshalAs(UnmanagedType.LPArray) > ByVal apidll As IntPtr(), ByVal dwFlags As UInteger ) As Integer
Public Declare Function CoCreateInstance Lib " ole32.dll " ( < [ In ]() > ByRef rclsid As Guid, ByVal pUnkOuter As IntPtr, ByVal dwClsContext As CLSCTX, < [ In ]() > ByRef riid As Guid, < Out() > ByRef ppv As IntPtr) As Integer
Public Enum CLSCTX As UInteger
INPROC_SERVER = & H1
End Enum
Dim CLSID_ShellLink = New Guid( " 00021401-0000-0000-C000-000000000046 " )
Dim IID_IShellLink = New Guid( " 000214F9-0000-0000-C000-000000000046 " )
Sub SelectFile( ByVal filePath As String )
Dim ppsl = IntPtr.Zero
Dim result = CoCreateInstance(CLSID_ShellLink, IntPtr.Zero, CLSCTX.INPROC_SERVER, IID_IShellLink, ppsl)
Dim psl As IShellLinkW = Marshal.GetObjectForIUnknown(ppsl)
psl.SetPath(filePath)
Dim pidl = IntPtr.Zero
psl.GetIDList(pidl)
SHOpenFolderAndSelectItems(pidl, 0 , Nothing , 0 )
Marshal.FreeCoTaskMem(pidl)
Marshal.Release(ppsl)
End Sub
< Serializable(), StructLayout(LayoutKind.Sequential) > Public Structure FILETIME
Public dwLowDateTime As UInteger
Public dwHighDateTime As UInteger
End Structure
< Serializable(), StructLayout(LayoutKind.Sequential, CharSet: = CharSet.Unicode), BestFitMapping( False ) > _
Public Structure WIN32_FIND_DATAW
Public dwFileAttributes As UInteger
Public ftCreationTime As FILETIME
Public ftLastAccessTime As FILETIME
Public ftLastWriteTime As FILETIME
Public nFileSizeHigh As UInteger
Public nFileSizeLow As UInteger
Public dwReserved0 As UInteger
Public dwReserved1 As UInteger
< MarshalAs(UnmanagedType.ByValTStr, sizeConst: = 260 ) > Public cFileName As String
< MarshalAs(UnmanagedType.ByValTStr, sizeConst: = 14 ) > Public cAlternateFileName As String
End Structure
< ComImport(), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), Guid( " 000214F9-0000-0000-C000-000000000046 " ) > _
Public Interface IShellLinkW
< PreserveSig() > Function GetPath( ByVal pszFile As StringBuilder, ByVal cch As Integer , < [ In ](), Out() > ByRef pfd As WIN32_FIND_DATAW, ByVal fFlags As UInteger ) As Integer
< PreserveSig() > Function GetIDList( < Out() > ByRef ppidl As IntPtr) As Integer
< PreserveSig() > Function SetIDList( < [ In ]() > ByRef pidl As IntPtr) As Integer
< PreserveSig() > Function GetDescription( ByVal pszName As StringBuilder, ByVal cch As Integer ) As Integer
< PreserveSig() > Function SetDescription( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszName As String ) As Integer
< PreserveSig() > Function GetWorkingDirectory( ByVal pszDir As StringBuilder, ByVal cch As Integer ) As Integer
< PreserveSig() > Function SetWorkingDirectory( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszDir As String ) As Integer
< PreserveSig() > Function GetArguments( ByVal pszArgs As StringBuilder, ByVal cch As Integer ) As Integer
< PreserveSig() > Function SetArguments( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszArgs As String ) As Integer
< PreserveSig() > Function GetHotkey( < Out() > ByRef pwHotkey As UShort ) As Integer
< PreserveSig() > Function SetHotkey( ByVal wHotkey As UShort ) As Integer
< PreserveSig() > Function GetShowCmd( < Out() > ByRef piShowCmd As Integer ) As Integer
< PreserveSig() > Function SetShowCmd( ByVal iShowCmd As Integer ) As Integer
< PreserveSig() > Function GetIconLocation( ByVal pszIconPath As StringBuilder, ByVal cch As Integer , < Out() > ByRef piIcon As Integer ) As Integer
< PreserveSig() > Function SetIconLocation( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszIconPath As String , ByVal iIcon As Integer ) As Integer
< PreserveSig() > Function SetRelativePath( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszPathRel As String , ByVal dwReserved As UInteger ) As Integer
< PreserveSig() > Function Resolve( ByVal hwnd As IntPtr, ByVal fFlags As UInteger ) As Integer
< PreserveSig() > Function SetPath( < MarshalAs(UnmanagedType.LPWStr) > ByVal pszFile As String ) As Integer
End Interface
End Module