如题
解决方案 »
- 战机射击游戏方面的一些经验小结.
- VB6.0如何判断Picture里是否有控件
- 为什么我的数据库恢复不行呀???
- 送上50分,问个傻问题。
- 求高手帮忙为下面代码设计一个流程图 谢谢啦
- textbox在双滚动条下怎么实现自动换行
- Rs.Update时怎么判断是INSERT还是UPDATE呢?
- 列举目录下文件和及其子目录下所有文件名??
- 如何取得文件的参数?!~~
- 三个疑问
- UPDATE baseinfo SET base_name='0' from buildcheck WHERE baseinfo.base_code==buildcheck.a_code
- 求助:如何剔除文本文件中的非数字字符?
'建立文件快捷方式.
'函数:CreateLink
'参数:
' FileFullName 对应的文件全称.
' IconLocation 图标路径
' LinkFolder 快捷方式的系统位置(枚举).
' UserLinkFolder 用户自定义快捷方式位置.
' LinkName 快捷方式名称.
' WorkingDirectory 工作目录.
' Hotkey 热键.
' WindowStyle 运行方式(枚举).
'返回值:无.
'例子:
'注:如果 UserLinkFolder 不为空.则 LinkFolder 无效,即:用户自定义位置优先.
Public Function CreateLink(FileFullName As String, _
Optional IconLocation As String = "", _
Optional LinkFolder As SmSysFolder = SmDeskTop, _
Optional UserLinkFolder As String = "", _
Optional LinkName As String = "", _
Optional WorkingDirectory As String = "", _
Optional Hotkey As String = "", _
Optional WindowStyle As SmWinStyle = SmNormalFocus) Dim GetName As New SmFileCls
Dim WSH_shell As New IWshRuntimeLibrary.IWshShortcut_Class 'IWshRuntimeLibrary.WshShell
Dim UrlLink As New IWshRuntimeLibrary.IWshShortcut_Class 'IWshRuntimeLibrary.WshShortcut
Dim LinkPath As String
Dim CreateDir As New SmFileCls On Error Resume Next
If Len(Trim$(WorkingDirectory)) = 0 Then
WorkingDirectory = GetName.FilePath(FileFullName)
End If
If Len(Trim$(LinkName)) = 0 Then
LinkName = GetName.FileName(FileFullName)
End If
If UCase$(Right$(LinkName, 3)) <> "LNK" Then
LinkName = LinkName & ".LNK"
End If
'/-----------------------------------------
If Len(Trim$(UserLinkFolder)) > 0 Then
LinkPath = UserLinkFolder
ElseIf IsNumeric(LinkFolder) Then
LinkPath = GetFolder(LinkFolder)
Else
Exit Function
End If
'/------------------------------------------
If Right$(LinkPath, 1) <> "\" Then LinkPath = LinkPath & "\"
If Len(Dir$(LinkPath, vbDirectory + vbHidden + vbReadOnly + vbSystem + vbAlias + vbNormal)) = 0 Then
If Not CreateDir.CreateDir(LinkPath) Then
Exit Function
End If
End If
LinkPath = LinkPath & LinkName
Set UrlLink = WSH_shell.CreateShortcut(LinkPath)
With UrlLink
.TargetPath = FileFullName
.IconLocation = IconLocation
.Hotkey = Hotkey
.WorkingDirectory = WorkingDirectory '起始位置
.WindowStyle = WindowStyle '开始样式
End With
UrlLink.Save '保存快捷方式
Set WSH_shell = Nothing
Set UrlLink = Nothing
Set GetName = Nothing
Set CreateDir = Nothing
End Function
http://vb1.myrice.com/article/system/sys031.htm
当然也可以用api函数OSfCreateShellLink建立快捷方式,vb6版本下的声明如下:
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 Long
' 创建和删除快捷方式
'-----------------------------------------------------
' 洪恩在线 求知无限
'-----------------------------------------------------
'------名称-------------------作用--------------------
' 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