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 OffImports System.ComponentModelNamespace LzmTW.uSystem.uIO
Public Class WshShortcut
Implements IDisposablePrivate gComIWshShortcut As Object
Private gComIWshShell3 As ObjectSub 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 PropertyPrivate 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 FunctionPublic 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 FunctionPrivate 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
