以下列出三种不同方法的代码供大家参考
1、注册表方式
模块代码
Option Explicit
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( ByVal hKey As Long , ByVal lpValueName As String , ByVal Reserved As Long , ByVal dwType As Long , lpData As Any, ByVal cbData As Long ) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( ByVal hKey As Long , ByVal lpSubKey As String , phkResult As Long ) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" ( ByVal hKey As Long ) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" ( ByVal hKey As Long , ByVal lpValueName As String ) As Long
Public Const REG_SZ = 1
Public Const HKEY_LOCAL_MACHINE = &H80000002
'*************************************************************************
'**函 数 名： SetAutoRun
'**输 入： ByVal Autorun(Boolean)
'**功能描述： 随WINDOWS自动启动/取消启动模块
'**调用方法： Call SetAutoRun(True/False)
'**作 者： Mr.David
'**日 期： 2006-09-05 09:07:25
'*************************************************************************
Public Sub SetAutoRun( ByVal Autorun As Boolean )
Dim KeyId As Long
Dim MyexePath As String
Dim regkey As String
MyexePath = App.Path & "\" & App.EXEName & ".exe" '获取程序位置
regkey = "Software\Microsoft\Windows\CurrentVersion\Run" '键值位置变量
Call RegCreateKey(HKEY_LOCAL_MACHINE, regkey, KeyId) '建立
If Autorun Then
RegSetValueEx KeyId, "MySoftware" , 0 &, REG_SZ, ByVal MyexePath, LenB(MyexePath)
Else
RegDeleteValue KeyId, "MySoftware"
End If
RegCloseKey KeyId
End Sub
调用方法
SetAutoRun( ByVal Autorun As Boolean )
-----------------------------------------------------------------------------------------------
2、利用Vb5stkit.dll里的函数
窗体部分代码，加入6个按钮。
Option Explicit
Private Sub CmdAddStartup_Click() '在开始菜单的启动程序组下创建记事本的快捷方式
Call OSfCreateShellLink( "\启动" , "记事本" , GetWindowsPath & "\Notepad.exe" , "" )
End Sub
Private Sub CmdAddDeskTop_Click() '在桌面创建记事本的快捷方式
Call OSfCreateShellLink( "..\..\桌面" , "记事本" , GetWindowsPath & "\Notepad.exe" , "" )
End Sub
Private Sub CmdAddProgram_Click() '在程序菜单的Notepad程序组下创建记事本的快捷方式
Call OSfCreateShellGroup( "Notepad" ) '先建立程序组
Call OSfCreateShellLink( "Notepad" , "记事本" , GetWindowsPath & "\Notepad.exe" , "" )
End Sub
Private Sub CmdAddStartMenu_Click()
Dim i As Long
For i = 1 To 5 '在开始菜单创建记事本的快捷方式,必须用循环才能创建?
Call OSfCreateShellLink( "..\..\「开始」菜单" , "记事本" , GetWindowsPath & "\Notepad.exe" , "" )
Next
End Sub
Private Sub CmdQuickLaunch_Click() '在快捷工具栏下创建记事本的快捷方式
Call OSfCreateShellLink( "..\..\Application Data\Microsoft\Internet Explorer\Quick Launch" , "记事本" , GetWindowsPath & "\Notepad.exe" , "" )
End Sub
Private Sub CmdDelAllLink_Click()
Call OSfRemoveShellLink( "..\..\「开始」菜单" , "记事本" ) '删除开始菜单上的快捷方式
Call OSfRemoveShellLink( "..\..\桌面" , "记事本" ) '删除桌面上的快捷方式
'Call OSfRemoveShellLink("Notepad", "记事本") '删除Notepad程序组下的快捷方式,这样不能删除程序组
Call RemoveShellGroup '删除Notepad程序组下的快捷方式
Call OSfRemoveShellLink( "\启动" , "记事本" ) '删除启动菜单下的快捷方式
Call OSfRemoveShellLink( "..\..\Application Data\Microsoft\Internet Explorer\Quick Launch" , "记事本" ) '删除快捷工具栏下的快捷方式
End Sub
Private Sub RemoveShellGroup()
On Error GoTo ToExit '打开错误陷阱
'------------------------------------------------
'RmDir删除一个存在的目录或文件夹。语法RmDir Path
'必要的 path 参数是一个字符串表达式，用来指定要删除的目录或文件夹。path 可以包含驱动器。如果没有指定驱动器，则 RmDir 会在当前驱动器上删除目录或文件夹。
'说明如果想要使用 RmDir 来删除一个含有文件的目录或文件夹，则会发生错误。在试图删除目录或文件夹之前，先使用 Kill 语句来删除所有文件。
Kill (GetProgarmPath(Me.hWnd) & "\Notepad\记事本.lnk" )
RmDir (GetProgarmPath(Me.hWnd) & "\Notepad" )
'------------------------------------------------
Exit Sub
ToExit:
Resume Next
End Sub
模块代码
Option Explicit
'-----------------------------------------------------
' 创建和删除快捷方式
'-----------------------------------------------------
' CmdAddStartup "创建启动程序组快捷方式"
' CmdAddDeskTop "创建桌面快捷方式"
' CmdAddStartMenu "创建开始菜单快捷方式"
' CmdAddProgram "创建程序组下的快捷方式"
' CmdQuickLaunch "创建快捷工具栏的快捷方式"
' CmdDelAllLink "删除所有快捷方式"
'-----------------------------------------------------
'要在VB中创建Windows的快捷方式，需要用到VB的一个动态链接库
'Vb5stkit.dll。在该动态链接库中提供了三个函数
'OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink
'分别用于创建快捷方式程序组、创建快捷方式和删除快捷方式。
'-----------------------------------------------------
Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" _
Alias "fCreateShellFolder" ( ByVal lpstrDirName As String ) As Long
'lpstrDirName指定了程序组的名称
'-----------------------------------------------------
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指定保存快捷方式的文件夹
'lpstrlinkname指定快捷方式的文件名
'lpstrLinkpathe指定快捷方式所指向的应用程序或文件
'lpstrLinkArguments是程序运行所需的参数
'-----------------------------------------------------
Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" Alias _
"fRemoveShellLink" ( ByVal lpstrFolderName As String , ByVal lpstrLinkName As String ) As Long
'获取Windows目录
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" ( ByVal lpBuffer As String , ByVal nSize As Long ) As Long
'获得文件夹路径
Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" ( ByVal hwndOwner As Long , ByVal lpszPath As String , ByVal nFolder As Long , ByVal fCreate As Long ) As Long
Private Const Max_Path = 260 '缓冲区大小
Private Const CSIDL_PROGRAMS = &H2 '程序组常量
'*************************************************************************
'**函 数 名： GetWindowsPath
'**输 入： 无
'**输 出： (String) -
'**功能描述： 得到Windows路径
'**全局变量：
'**调用模块：
'**作 者： Mr.David
'**日 期： 2006-09-19 19:49:17
'**修 改 人：
'**日 期：
'**版 本： V1.0.0
'*************************************************************************
Public Function GetWindowsPath() As String
Dim ChrLen As Long , WinDir As String
WinDir = Space$(Max_Path)
ChrLen = GetWindowsDirectory(WinDir, Max_Path)
WinDir = Left$(WinDir, ChrLen)
GetWindowsPath = WinDir
End Function
'*************************************************************************
'**函 数 名： GetProgarmPath
'**输 入： frmHwnd(Long) -
'**输 出： (String) -
'**功能描述： 获取开始菜单程序组的路径
'**作 者： Mr.David
'**日 期： 2006-09-19 19:48:16
'*************************************************************************
Public Function GetProgarmPath(frmHwnd As Long ) As String
Dim CSILD_NUM As Long , strBouff As String
strBouff = String$ (Max_Path, 0 )
SHGetSpecialFolderPath frmHwnd, strBouff, CSIDL_PROGRAMS, 0
GetProgarmPath = Left$(strBouff, InStr( 1 , strBouff, Chr$( 0 )) - 1 )
End Function
-----------------------------------------------------------------------------------------------
3、引用系统里面都有的WSHom.Ocx
Option Explicit
'*************************************************************************
'**函 数 名： SetAutoRun
'**输 入： ByVal Autorun(Boolean)
'**功能描述： 随WINDOWS自动启动/取消启动模块
'**调用方法： Call SetAutoRun(True/False)
'**作 者： Mr.David
'**日 期： 2006-09-05 09:07:25
'*************************************************************************
Public Sub SetAutoRun( ByVal Autorun As Boolean )
'WshShell 对象
'ProgId Wscript.Shell
'文件名 WSHom.Ocx
Dim WshShell As WshShell
Set WshShell = CreateObject( "Wscript.Shell" )
If Autorun Then
WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"
Else
WshShell.RegDelete "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName
End If
Set WshShell = Nothing
End Sub