vb 创建快捷方式 兼容vista XP

'创建快捷方式，兼容vista
'要把vb6stkit.DLL放到程序目录
'敖士伟 09-10-27
'只对“桌面”和“开启”有效，其它还没做
'=========开启外部同步程序定义开始
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF 'Wait forever
Const WAIT_OBJECT_0 = 0 'The state of the specified object is signaled.
Const WAIT_TIMEOUT = &H102 'The time-out interval elapsed, and the
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'=========开启外部同步程序定义结束
'创建快捷方式
Private Declare Function fCreateShellLink Lib "vb6stkit.DLL" ( _
ByVal lpstrFolderName As String, _
ByVal lpstrLinkName As String, _
ByVal lpstrLinkPath As String, _
ByVal lpstrLinkArgs As String, _
ByVal fPrivate As Long, _
ByVal sParent As String) As Long
'
'lpstrFolderName 文件夹的名称 “$(proprams)” 程序组 "$(Strar Menu)" 开始菜单
'lpstrLinkName 快捷键的名称
'
'lpstrLinkPath 快捷键的路径
'
'lpstrLinkArgs 这里是命令行参数
'
'fPrivate True
'
'sParent 上一层文件夹
'快捷方式中的常数
Public Enum ShortCutPosition
vbDesktop = 1 '桌面
vbStart = 2 '启动项
vbStartMenu = 3 '开始菜单程序项
vbGroup = 4 '开始菜单顶端
End Enum
'开启外部同步程序过程
Private Sub cmdShell(s_cmd As String)
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
lPid = Shell(s_cmd, vbNormalFocus)
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid) 'Get a handle to the shelled process.
If lHnd <> 0 Then 'If successful, wait for the
lRet = WaitForSingleObject(lHnd, INFINITE) ' application to end.
CloseHandle (lHnd)