一个创建快捷方式类

Author:水如烟

利用了WScript.Shell

示例:

Namespace LzmTW.uSystem.uIO
    Public Class ShortcutDemo

        '示例,创建当前程序的快捷方式到桌面
        Public Shared Sub CreateCurrentAppShortCutOnDesktop()
            Dim args(My.Application.CommandLineArgs.Count - 1) As String
            My.Application.CommandLineArgs.CopyTo(args, 0)

            Dim appName As String = My.Application.Info.Title
            Dim mShortcut As WshShortcut
            mShortcut = WshShortcut.CreateIn(Environment.SpecialFolder.Desktop, appName)
            With mShortcut
                .TargetPath = Application.ExecutablePath
                .Arguments = String.Join(",", args)
                .Description = My.Application.Info.Description
                .Hotkey = Keys.Control Or Keys.Alt Or Keys.A
                .WindowStyle = WshWindowStyle.WshMaximizedFocus
                .WorkingDirectory = .SpecialFolder(Environment.SpecialFolder.MyDocuments)
                '.SetDefaultIcon()
                .Save()
                .Dispose()
            End With
        End Sub
    End Class
End Namespace

类:

 

Option Strict Off

Imports System.ComponentModel

Namespace LzmTW.uSystem.uIO
    Public Class WshShortcut
        Implements IDisposable

        Private gComIWshShortcut As Object
        Private gComIWshShell3 As Object

        Sub New()
            gComIWshShell3 = CreateObject("WScript.Shell")
        End Sub

        ''' <summary>
        ''' 打开或准备创建
        ''' </summary>
        ''' <param name="PathLink">快捷方式全名</param>
        ''' <remarks>如要创建或修改,配置参数后需要保存</remarks>
        Public Sub Create(ByVal PathLink As String)
            If Not PathLink.ToLower.EndsWith(".lnk") Then
                PathLink = PathLink & ".lnk"
            End If

            OnlyMeDispose()

            gComIWshShortcut = gComIWshShell3.CreateShortcut(PathLink)
        End Sub

        '舍去不用
        Private Sub Load(ByVal PathLink As String)
            gComIWshShortcut.Load(PathLink)
        End Sub

        ''' <summary>
        ''' 保存(创建或更改当前快捷方式)
        ''' </summary>
        Public Sub Save()
            gComIWshShortcut.Save()
        End Sub

        ''' <summary>
        ''' 目标
        ''' </summary>
        Public Property TargetPath() As String
            Get
                Return gComIWshShortcut.TargetPath
            End Get
            Set(ByVal value As String)
                gComIWshShortcut.TargetPath = value
            End Set
        End Property

        ''' <summary>
        ''' 目标参数
        ''' </summary>
        Public Property Arguments() As String
            Get
                Return gComIWshShortcut.Arguments
            End Get
            Set(ByVal value As String)
                gComIWshShortcut.Arguments = value
            End Set
        End Property

        ''' <summary>
        ''' 备注
        ''' </summary>
        Public Property Description() As String
            Get
                Return gComIWshShortcut.Description
            End Get
            Set(ByVal value As String)
                gComIWshShortcut.Description = value
            End Set
        End Property

        ''' <summary>
        ''' 快捷方式全名
        ''' </summary>
        Public ReadOnly Property FullName() As String
            Get
                Return gComIWshShortcut.FullName
            End Get
        End Property

        ''' <summary>
        ''' 快捷键
        ''' </summary>
        Public Property Hotkey() As Keys
            Get
                Return KeysConverter.ConvertFromString(gComIWshShortcut.Hotkey)
            End Get
            Set(ByVal value As Keys)
                gComIWshShortcut.Hotkey = KeysConverter.ConvertTo(value, GetType(String))
            End Set
        End Property

        ''' <summary>
        ''' 图标位置
        ''' </summary>
        Public Property IconLocation() As String
            Get
                Return gComIWshShortcut.IconLocation
            End Get
            Set(ByVal value As String)
                gComIWshShortcut.IconLocation = value
            End Set
        End Property

        ''' <summary>
        ''' 相对路径
        ''' </summary>
        Public WriteOnly Property RelativePath() As String
            Set(ByVal value As String)
                gComIWshShortcut.RelativePath = value
            End Set
        End Property

        ''' <summary>
        ''' 运行方式
        ''' </summary>
        Public Property WindowStyle() As WshWindowStyle
            Get
                Return gComIWshShortcut.WindowStyle
            End Get
            Set(ByVal value As WshWindowStyle)
                gComIWshShortcut.WindowStyle = value
            End Set
        End Property

        ''' <summary>
        ''' 起始位置
        ''' </summary>
        Public Property WorkingDirectory() As String
            Get
                Return gComIWshShortcut.WorkingDirectory
            End Get
            Set(ByVal value As String)
                gComIWshShortcut.WorkingDirectory = value
            End Set
        End Property

        Private Sub OnlyMeDispose()
            If gComIWshShortcut Is Nothing Then Return

            System.Runtime.InteropServices.Marshal.ReleaseComObject(gComIWshShortcut)
            gComIWshShortcut = Nothing
        End Sub

        ''' <summary>
        ''' 释放内存
        ''' </summary>
        Public Sub Dispose() Implements System.IDisposable.Dispose
            OnlyMeDispose()

            System.Runtime.InteropServices.Marshal.ReleaseComObject(gComIWshShell3)
            gComIWshShell3 = Nothing
        End Sub

        ''以下为补充

        ''' <summary>
        ''' 默认图标位置
        ''' </summary>
        Public Function DefaultIcon() As String
            Return "%SystemRoot%system32SHELL32.dll,30"
        End Function

        Public Sub SetDefaultIcon()
            Me.IconLocation = Me.DefaultIcon
        End Sub

        ''' <summary>
        ''' 获取常用目录
        ''' </summary>
        Public Function SpecialFolder(ByVal folder As Environment.SpecialFolder) As String
            Return Environment.GetFolderPath(folder)
        End Function

        ''' <summary>
        ''' 在指定目录下打开或准备创建快捷方式
        ''' </summary>
        ''' <param name="folder">目录</param>
        ''' <param name="name">快捷方式名称</param>
        ''' <remarks>如要创建或修改,配置参数后需要保存</remarks>
        Public Shared Function CreateIn(ByVal folder As Environment.SpecialFolder, ByVal name As String) As WshShortcut
            Dim mShortcut As New WshShortcut
            Dim mPathLink As String = String.Concat(mShortcut.SpecialFolder(folder), "\", name)
            mShortcut.Create(mPathLink)
            Return mShortcut
        End Function

        Private Shared KeysConverter As New KeysConverter
    End Class
End Namespace

 

Namespace LzmTW.uSystem.uIO
    Public Enum WshWindowStyle
        'WshHide = 0
        WshNormalFocus = 1
        'WshMinimizedFocus = 2
        WshMaximizedFocus = 3
        'WshNormalNoFocus = 4
        'WshMinimizedNoFocus = 6
        WshMinimizedFocus = 7
    End Enum
End Namespace