vb如何用程序在桌面生成一快捷方式

Question

我做的一是绿色版所以需要用程序在桌面生成一快捷方式
另外还要判断是否已经有了这个快捷方式没有的化就不生成了
该如何操作？

Answer 1

Dim appdisk$, Fname$
Private Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
Dim Winsys$, aa$
Public Function GetSysPath() As String
   aa = Trim(Environ("ComSpec"))
   GetSysPath = Mid(aa, 1, InStrRev(aa, "\"))
End FunctionPrivate Sub Form_Load()
   appdisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
   Fname = appdisk & "工程1.exe"
   Call OSfCreateShellLink("..\..\桌面", "工程1", appdisk & "工程1.exe", "")
End Sub

Answer 2

提示 实时错误 '53'文件未找到 vb5stkit.dll

Answer 3

'-----------------------------------------------------
'               创建和删除快捷方式
'-----------------------------------------------------
'               洪恩在线  求知无限
'-----------------------------------------------------
'------名称-------------------作用--------------------
'       CmdAdd1             "创建test程序组快捷方式"按钮
'       CmdAdd2             "创建桌面快捷方式"按钮
'       CmdAdd3             "创建开始菜单快捷方式"按钮
'       CmdAdd4             "创建Test程序组下的快捷方式"按钮
'       CmdDel              "删除所有快捷方式"按钮
'-----------------------------------------------------
'要在VB中创建Windows的快捷方式，需要用到VB的一个动态链接库
'Vb5stkit.dll。在该动态链接库中提供了三个函数
'OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink
'分别用于创建快捷方式程序组、创建快捷方式和删除快捷方式。
'-----------------------------------------------------
Private Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" _
Alias "fCreateShellFolder" (ByVal lpstrDirName As String) As Long
'lpstrDirName指定了程序组的名称
'-----------------------------------------------------
Private Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" _
Alias "fCreateShellLink" (ByVal lpstrFolderName As String, _
ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
'lpstrfoldername指定保存快捷方式的文件夹，默认为“c:\Windows\start menu\programs”
'lpstrlinkname指定快捷方式的文件名
'lpstrpathname指定快捷方式所指向的应用程序或文件
'-----------------------------------------------------
Private Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" _
Alias "fRemoveShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As LongDim lresult As Long
Private Sub CmdAdd1_Click()
    Dim lresult As Long
    '在程序菜单中添加一个名为Test的程序组
    lresult = OSfCreateShellGroup("Test")
End SubPrivate Sub CmdDel_Click()
Dim lresult As Long
    '删除开始菜单上的快捷方式
    lresult = OSfRemoveShellLink("..\..\start menu", "记事本")
    '删除桌面上的快捷方式
    lresult = OSfRemoveShellLink("..\..\desktop", "记事本")
    '删除Test程序组下的快捷方式
    lresult = OSfRemoveShellLink("Test", "记事本")
    
End SubPrivate Sub CmdAdd2_Click()
    Dim lresult As Long
    '在桌面创建记事本的快捷方式
    lresult = OSfCreateShellLink("..\..\desktop", "记事本", "c:\Windows\notepad.exe", "")
End SubPrivate Sub CmdAdd4_Click()
    '在程序菜单的Test程序组下创建记事本的快捷方式
    lresult = OSfCreateShellLink("test", "记事本", "c:\Windows\notepad.exe", "")
End SubPrivate Sub CmdAdd3_Click()
    '在开始菜单创建记事本的快捷方式
    lresult = OSfCreateShellLink("..\..\start menu", "记事本", "c:\Windows\notepad.exe", "")
End Sub

Answer 4

'事先在工程菜单中引用c:\windows\system32\WSHom.Ocx'读取快捷方式属性
Private Sub Command1_Click()
    Dim WSH As WshShell
    Dim Urllink As WshShortcut
    Dim DeskPath As String
    Dim lnkName As String
      Set WSH = New WshShell
    DeskPath = WSH.SpecialFolders("Desktop")  '获得桌面路径
    
    lnkName = Dir(DeskPath & "\AA.lnk")
    Set Urllink = WSH.CreateShortcut(DeskPath & "\" & lnkName)
    With Urllink
        Print .TargetPath          '目标
        Print .Hotkey              '热键
        Print .WorkingDirectory    '工作目录
        Print .WindowStyle         '运行方式
        Print .Description         '备注
  End With
  Set Urllink = Nothing
  Set WSH = Nothing
  
End SubPrivate Sub Command2_Click()
'引用windows scripting host object model   Dim WSH As WshShell
    Dim Urllink As WshShortcut
    Dim DeskPath As String
    Dim lnkName As String
  
    Set WSH = New WshShell
    DeskPath = WSH.SpecialFolders("Desktop")  '获得桌面路径
    
    '得到快捷方式
    lnkName = Dir(DeskPath & "\*.lnk")
    Debug.Print lnkName
    While Len(lnkName)
        Debug.Print lnkName
        lnkName = Dir
    Wend
    
    '可以用wsh_shell.expandenvironmentstrings("%windir%")获得windows路径
    Set Urllink = WSH.CreateShortcut(DeskPath & "\Test.lnk")
    With Urllink
        .TargetPath = "d:\test.txt"         '目标
        .IconLocation = WSH.ExpandEnvironmentStrings _
            ("%SystemRoot%\system32\SHELL32.dll,70")     '图标,可以是自己的ico
        .Hotkey = "ctrl+shift+F"            '快捷键
        .WorkingDirectory = "d:\"           '起始位置
        .WindowStyle = 1                    '运行方式
        .Description = "新疆鼎立科技"       '备注
        .Arguments = StrArg '参数
  End With
  Urllink.Save '保存快捷方式
  
'  '添加到桌面
'lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windows\calc.exe", "")
''添加到程序组
'lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe", "")
''添加到启动组
'lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\calc.exe", "")
  
End SubPrivate Sub Form_Load()End Sub