一个创建快捷方式类

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