请问，怎样用vb制作快捷方式~！

Question

代码如下：
Declare Function OSfCreateShellGroup Lib "STKIT432.DLL" Alias "fCreateShellFolder" _ 
(ByVal lpstrDirName As String) As LongDeclare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, _
ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As LongPublic Sub CreateShellGroup(ByVal strFolderName As String)If strFolderName = "" Then
Exit Sub
End IfDim fSuccess As Boolean
fSuccess = OSfCreateShellGroup(strFolderName)End Sub
'use asDim res&
Dim vLocation$vLocation$ = "testing"
Call CreateShellGroup(vLocation$)
vLocation$ = "..\..\Start Menu\Programs\" & vLocation$
res& = fCreateShellLink(vLocation, [title], [path&executable], "")'where
' title = name to be mentioned
' path&executable = full path and executable name of application

Answer 1

Private Declare Function OSfCreateShellLink Lib "vb6stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String, ByVal fPrivate As Long, ByVal sParent As String) As LongOSfCreateShellLink  "c:\windows\DESKTOP\", "桌面上的快捷方式", "c:\windows\notepad.exe", vbNull, 0, ""

Answer 2

Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long 
Sub Command1_Click()Dim lReturn As Long'添加到桌面
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 Sub 

Answer 3

[名称]           用DDE创建桌面快捷方式[语言种类]       Visual Basic[类别一]         系统操控[类别二]         底层开发[类别三]         系统[数据来源]       dapha.net[保存时间]       2002-12-06[关键字一]       DDE[关键字二]       创建[关键字三]       快捷方式[内容简介]       空[源代码内容]用DDE创建桌面快捷方式
受"用DDE连接方法向开始菜单中添加快捷方式"一文的启发，我写了一个可以向桌面增加快捷方式的小程序。与调用Vb5stkit.dll或Vb6stkit.dll来建立快捷方式相比，最大的特点在于避免了对该DLL文件的依赖(并不是每一台Win9x的机上都有的这些文件的)。是不是很环保？
　　原理：利用Text控件的DDE在系统开始菜单中添加一个快捷方式，然后将该快捷方式剪切到桌面上来。
　　须解决的问题：取得系统开始菜单和桌面的路径。这其中当然免不了要调用到API的SHGetSpecialFolderLocation 和SHGetPathFromIDList 函数。　　实现步骤：　　1.新建工程；　　2.在表单中增加一个文本框（txtLnk）及一个命令按钮（cmdMakeLnk）；　　3.加入以下代码：Option Explicit
Const CSIDL_DESKTOP = &H0 系统桌面
Const CSIDL_PROGRAMS = &H2 系统"开始-$#@62;程序"菜单
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetSpecialFolderLocation _
Lib "shell32.dll" (ByVal hwndOwner As Long, _
ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
定义取得系统特定文件夹的路径的函数。Private Function GetSpecialfolder(CSIDL As Long) As StringDim lRet As LongDim IDL As ITEMIDLISTDim sPath As StringlRet = SHGetSpecialFolderLocation(100, CSIDL, IDL)　　错误时返回非0值If lRet = 0 ThensPath = Space$(512)lRet = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)　　一定要删除末尾的 0 字节。这在调用API时常常会遇到。GetSpecialfolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)Exit FunctionEnd IfGetSpecialfolder = ""End FunctionPrivate Sub cmdMakeLnk_Click()Dim sProgramsPath As StringDim sDesktopPath As StringsProgramsPath = GetSpecialfolder(CSIDL_PROGRAMS)sDesktopPath = GetSpecialfolder(CSIDL_DESKTOP)txtLnk.LinkTopic = "Progman|Progman"txtLnk.LinkMode = 2
格式：　　"[AddItem($#@60;欲建立快捷方式的命令行（可以是文件夹）$#@62;,$#@60;快捷方式的名称$#@62; ,[快捷方式的图标文件],[第几个图标])]"　　注意:　　 1、由于文件名是字符串，所以必须加引号，也就是以下这行命令为什么们用了两个引号的原因　　 2、在"快捷方式的图标文件"中所出现的路径及文件必须是8.3格式，不支持长文件名。　　下面假设为 C:\WINDOWS\CALC.EXE建立快捷方式txtLnk.LinkExecute "[AddItem(""C:\WINDOWS\CALC.EXE"",""计算器"" )]"　　将快捷方式移至桌面sProgramsPath = sProgramsPath & "\计算器.lnk"sDesktopPath = sDesktopPath & "\计算器.lnk"FileCopy sProgramsPath, sDesktopPath
Kill sProgramsPath
End Sub
作者:我的好友lonstar
以上在Windows98、ME + VB5、VB6通过。有任何问题欢迎你跟我联系[email protected]     以上代码保存于： SourceCode Explorer(源代码数据库)
           复制时间： 2002-12-06 23:39
           软件版本： 1.0.778
           软件作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729