在winforms VS2017中创建快捷方式

Question

我需要能够使用 VS2017 在 winforms 中创建快捷方式。我找到了很多解决方案，但由于某种原因，IWshRuntimeLibrary 库似乎在 VS 2017 中不起作用。

我可以添加参考，但参考列表中有一个警告符号用于此参考。因此 Imports IWshRuntimeLibrary 语句不起作用，我找到的代码也不起作用......

想法？

TIA，

英里 (Win7 Pro x 64)

Answer 1

通过 Win32 API 创建快捷方式的完整解决方案：

Public NotInheritable Class Win32Interop

    Private Sub New()
    End Sub

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/bb774944%28v=vs.85%29.aspx
    <Flags>
    Public Enum IShellLinkGetPathFlags
        ShortPath = &H1
        UncPriority = &H2
        RawPath = &H4
    End Enum

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/bb774952%28v=vs.85%29.aspx
    <Flags>
    Public Enum IShellLinkResolveFlags
        NoUI = &H1
        Update = &H4
        NoUpdate = &H8
        NoSearch = &H10
        Notrack = &H20
        NoLinkInfo = &H40
        InvokeMsi = &H80
    End Enum

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms633548%28v=vs.85%29.aspx
    Public Enum WindowState As Integer
        Hide = 0
        Normal = 1
        ShowMinimized = 2
        Maximize = 3
        ShowMaximized = WindowState.Maximize
        ShowNoActivate = 4
        Show = 5
        Minimize = 6
        ShowMinNoActive = 7
        ShowNA = 8
        Restore = 9
        ShowDefault = 10
        ForceMinimize = 11
    End Enum

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/aa365740%28v=vs.85%29.aspx
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
    Public Structure Win32FindDataW
        Public DwFileAttributes As UInteger
        Public FtCreationTime As Long
        Public FtLastAccessTime As Long
        Public FtLastWriteTime As Long
        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

    ' CLSID_ShellLink from ShlGuid.h header file.
    <ComImport>
    <ClassInterface(ClassInterfaceType.None)>
    <Guid("00021401-0000-0000-C000-000000000046")>
    Public Class CShellLink
    End Class

    ' http://msdn.microsoft.com/es-es/library/windows/desktop/bb774950%28v=vs.85%29.aspx
    <ComImport>
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    <Guid("000214F9-0000-0000-C000-000000000046")>
    Public Interface IShellLinkW
        Sub GetPath(<Out(), MarshalAs(UnmanagedType.LPWStr)> ByVal pszFile As StringBuilder,
                                                             ByVal cchMaxPath As Integer,
                                                             ByRef refWin32FindData As Win32FindDataW,
                                                             ByVal fFlags As IShellLinkGetPathFlags)
        Sub GetIDList(ByRef refPidl As IntPtr)
        Sub SetIDList(ByVal pidl As IntPtr)
        Sub GetDescription(<Out(), MarshalAs(UnmanagedType.LPWStr)> ByVal pszName As StringBuilder,
                                                                    ByVal cchMaxName As Integer)
        Sub SetDescription(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszName As String)
        Sub GetWorkingDirectory(<Out(), MarshalAs(UnmanagedType.LPWStr)> ByVal pszDir As StringBuilder,
                                                                         ByVal cchMaxPath As Integer)
        Sub SetWorkingDirectory(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszDir As String)
        Sub GetArguments(<Out(), MarshalAs(UnmanagedType.LPWStr)> ByVal pszArgs As StringBuilder,
                                                                  ByVal cchMaxPath As Integer)
        Sub SetArguments(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszArgs As String)
        Sub GetHotkey(ByRef refHotkey As UShort)
        Sub SetHotkey(ByVal wHotkey As UShort)
        Sub GetShowCmd(ByRef refShowCmd As WindowState)
        Sub SetShowCmd(ByVal iShowCmd As WindowState)
        Sub GetIconLocation(<Out(), MarshalAs(UnmanagedType.LPWStr)> ByVal pszIconPath As StringBuilder,
                                                                     ByVal cchIconPath As Integer,
                                                                     ByRef refIconIndex As Integer)
        Sub SetIconLocation(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszIconPath As String,
                                                              ByVal iIcon As Integer)
        Sub SetRelativePath(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszPathRel As String,
                                                              ByVal dwReserved As Integer)

        Sub Resolve(ByVal hwnd As IntPtr, ByVal fFlags As IShellLinkResolveFlags)
        Sub SetPath(ByVal pszFile As String)
    End Interface

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms688695%28v=vs.85%29.aspx
    <ComImport>
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    <Guid("0000010c-0000-0000-c000-000000000046")>
    Public Interface IPersist
        <PreserveSig()>
        Sub GetClassID(ByRef refClassID As Guid)
    End Interface

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms687223%28v=vs.85%29.aspx
    <ComImport>
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    <Guid("0000010b-0000-0000-C000-000000000046")>
    Public Interface IPersistFile : Inherits IPersist
        Shadows Sub GetClassID(ByRef refClassID As Guid)
        <PreserveSig()>
        Function IsDirty() As Integer
        <PreserveSig()>
        Sub Load(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszFileName As String,
                                                           ByVal dwMode As UInteger)
        <PreserveSig()>
        Sub Save(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszFileName As String,
                 <[In](), MarshalAs(UnmanagedType.Bool)> ByVal fRemember As Boolean)
        <PreserveSig()>
        Sub SaveCompleted(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszFileName As String)
        <PreserveSig()>
        Sub GetCurFile(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal ppszFileName As String)
    End Interface

End Class

然后：

Imports Win32Interop

Namespace Shortcuts

    ' http://msdn.microsoft.com/en-us/library/windows/desktop/bb774926%28v=vs.85%29.aspx
    ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646278%28v=vs.85%29.aspx
    <Flags>
    Public Enum ShortcutHotkeyModifier As Short
        None = 0S
        Shift = 1S
        Control = 2S
        Alt = 4S
        Win = 8S
    End Enum

    ' http://msdn.microsoft.com/es-es/library/windows/desktop/bb761056%28v=vs.85%29.aspx
    Public Enum ShortcutWindowState As Integer
        None = 0
        Normal = 1
        Maximized = 3
        Minimized = 7
    End Enum

    <Serializable>
    <XmlRoot("ShortcutInfo")>
    Public NotInheritable Class ShortcutInfo
        Public Property ShortcutFile As String
        Public Property Description As String
        Public Property Arguments As String
        Public Property Target As String
        Public Property WorkingDir As String
        Public Property Icon As String
        Public Property IconIndex As Integer
        Public Property Hotkey As String
        Public Property HotkeyModifier As ShortcutHotkeyModifier
        Public Property HotkeyAccesor As Keys
        Public Property WindowState As ShortcutWindowState
        Public Property IsFile As Boolean
        Public Property IsDirectory As Boolean
        Public Property DriveLetter As String
        Public Property DirectoryName As String
        Public Property FileName As String
        Public Property FileExtension As String
        Public Sub New()
        End Sub

        <DebuggerStepThrough>
        Public Sub Create()

            Me.CreateShortcut(Me.ShortcutFile, Me.Target, Me.WorkingDir,
                              Me.Description, Me.Arguments,
                              Me.Icon, Me.IconIndex,
                              Me.HotkeyModifier, Me.HotkeyAccesor,
                              Me.WindowState)

        End Sub

        Private Sub CreateShortcut(ByVal filePath As String, ByVal target As String,
                                   Optional ByVal workingDirectory As String = "",
                                   Optional ByVal description As String = "",
                                   Optional ByVal arguments As String = "",
                                   Optional ByVal icon As String = "",
                                   Optional ByVal iconIndex As Integer = 0,
                                   Optional ByVal hotKeyModifier As ShortcutHotkeyModifier = ShortcutHotkeyModifier.None,
                                   Optional ByVal hotkeyAccesor As Keys = Keys.None,
                                   Optional ByVal windowState As ShortcutWindowState = ShortcutWindowState.Normal)

            Dim lnk As New CShellLink
            Dim lnkW As IShellLinkW

            DirectCast(lnk, IPersistFile).Load(filePath, 0)
            lnkW = DirectCast(lnk, IShellLinkW)

            With lnkW
                .SetPath(target)
                .SetDescription(description)
                .SetArguments(arguments)
                .SetIconLocation(icon, iconIndex)
                .SetShowCmd(DirectCast(windowState, WindowState))

                .SetWorkingDirectory(If(Not String.IsNullOrEmpty(workingDirectory),
                                        workingDirectory,
                                        Path.GetDirectoryName(target)))

                .SetHotkey(If(hotKeyModifier + hotkeyAccesor <> 0,
                              Me.CreateWord(Convert.ToByte(hotkeyAccesor), Convert.ToByte(hotKeyModifier)),
                              Nothing))
            End With

            DirectCast(lnkW, IPersistFile).Save(filePath, True)
            DirectCast(lnkW, IPersistFile).SaveCompleted(filePath)

            Marshal.FinalReleaseComObject(lnkW)
            Marshal.FinalReleaseComObject(lnk)

        End Sub

        ' Creates a WORD value (16-Bit Unsigned Integer) from a LOBYTE and a HIBYTE.
        Private Function CreateWord(ByVal loByte As Byte, ByVal hiByte As Byte) As UShort
            Return BitConverter.ToUInt16({loByte, hiByte}, 0)
        End Function

    End Class

End Namespace

注意：我删除了所有 XML 文档以减少此答案的代码大小。

用法示例：

Imports Shortcuts

Dim shortcut As New ShortcutInfo
With shortcut
    .ShortcutFile = "C:\My Shortcut.lnk"
    .Target = "C:\Target File.txt"
    .Arguments = ""
    .Description = "My shortcut description"
End With

shortcut.Create()