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
