VB开机运行程序

有两种方法，1是注册表方式

模块代码

2. Option Explicit
4. 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
6. Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
8. Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
10. Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
12. Public Const REG_SZ = 1
14. Public Const HKEY_LOCAL_MACHINE = 
16. '*************************************************************************
17. '**函 数 名： SetAutoRun
18. '**输    入： ByVal Autorun(Boolean) -
19. '**输    出： 无
20. '**功能描述： 随WINDOWS自动启动/取消启动模块
21. '**全局变量：
22. '**调用方法： Call SetAutoRun(True/False)
23. '**作    者： Mr.David
24. '**日    期： 2006-09-05 09:07:25
25. '**修 改 人：
26. '**日    期：
27. '**版    本： V1.0.0
28. '*************************************************************************
30. Public Sub SetAutoRun(ByVal Autorun As Boolean)
32.     Dim KeyId As Long
33.     Dim MyexePath As String
34.     Dim regkey As String
35.     
36.     MyexePath = App.Path & "/" & App.EXEName & ".exe" '获取程序位置
38.     regkey = "Software/Microsoft/Windows/CurrentVersion/Run" '键值位置变量
40.     Call RegCreateKey(HKEY_LOCAL_MACHINE, regkey, KeyId) '建立
41.     
42.     If Autorun Then
44.         RegSetValueEx KeyId, "MySoftware", 0&, REG_SZ, ByVal MyexePath, LenB(MyexePath)
46.     Else
48.         RegDeleteValue KeyId, "MySoftware"
50.     End If
52.     RegCloseKey KeyId
54. End Sub
56. 调用方法
58. SetAutoRun(ByVal Autorun As Boolean)
61. '2是利用Vb5stkit.dll里面的函数
63. '窗体部分代码,加入6个按钮
65. Option Explicit
67. Private Sub CmdAddStartup_Click()       '在开始菜单的启动程序组下创建记事本的快捷方式
69.     Call OSfCreateShellLink("/启动", "记事本", GetWindowsPath & "/Notepad.exe", "")
71. End Sub
73. Private Sub CmdAddDeskTop_Click()       '在桌面创建记事本的快捷方式
75.     Call OSfCreateShellLink("../../桌面", "记事本", GetWindowsPath & "/Notepad.exe", "")
77. End Sub
79. Private Sub CmdAddProgram_Click()       '在程序菜单的Notepad程序组下创建记事本的快捷方式
81.     Call OSfCreateShellGroup("Notepad") '先建立程序组
83.     Call OSfCreateShellLink("Notepad", "记事本", GetWindowsPath & "/Notepad.exe", "")
85. End Sub
87. Private Sub CmdAddStartMenu_Click()
89.     Dim i As Long
91.     For i = 1 To 5                     '在开始菜单创建记事本的快捷方式,必须用循环才能创建?
92.         
93.         Call OSfCreateShellLink("../../「开始」菜单", "记事本", GetWindowsPath & "/Notepad.exe", "")
95.     Next
97. End Sub
98.     
99. Private Sub CmdQuickLaunch_Click()     '在快捷工具栏下创建记事本的快捷方式
101.     Call OSfCreateShellLink("../../Application Data/Microsoft/Internet Explorer/Quick Launch", "记事本", GetWindowsPath & "/Notepad.exe", "")
103. End Sub
105. Private Sub CmdDelAllLink_Click()
107.     Call OSfRemoveShellLink("../../「开始」菜单", "记事本")         '删除开始菜单上的快捷方式
109.     Call OSfRemoveShellLink("../../桌面", "记事本")                 '删除桌面上的快捷方式
111.     'Call OSfRemoveShellLink("Notepad", "记事本")                   '删除Notepad程序组下的快捷方式,这样不能删除程序组
112.     
113.     Call RemoveShellGroup                                           '删除Notepad程序组下的快捷方式
115.     Call OSfRemoveShellLink("/启动", "记事本")                      '删除启动菜单下的快捷方式
117.     Call OSfRemoveShellLink("../../Application Data/Microsoft/Internet Explorer/Quick Launch", "记事本")     '删除快捷工具栏下的快捷方式
119. End Sub
121. Private Sub RemoveShellGroup()
123.     On Error GoTo ToExit '打开错误陷阱
125.     '------------------------------------------------
127.     'RmDir删除一个存在的目录或文件夹。语法RmDir Path
128.     '必要的 path 参数是一个字符串表达式，用来指定要删除的目录或文件夹。path 可以包含驱动器。如果没有指定驱动器，则 RmDir 会在当前驱动器上删除目录或文件夹。
129.     '说明如果想要使用 RmDir 来删除一个含有文件的目录或文件夹，则会发生错误。在试图删除目录或文件夹之前，先使用 Kill 语句来删除所有文件。
131.     Kill (GetProgarmPath(Me.hWnd) & "/Notepad/记事本.lnk")
132.     RmDir (GetProgarmPath(Me.hWnd) & "/Notepad")
134.     '------------------------------------------------
136.     Exit Sub
138.     '----------------
140. ToExit:
142.     Resume Next
144. End Sub
146. '模块代码
148. Option Explicit
150. '-----------------------------------------------------
151. '               创建和删除快捷方式
152. '-----------------------------------------------------
153. '               洪恩在线  求知无限
154. '-----------------------------------------------------
155. '------名称-------------------作用--------------------
156. '       CmdAddStartup             "创建启动程序组快捷方式"
157. '       CmdAddDeskTop             "创建桌面快捷方式"
158. '       CmdAddStartMenu           "创建开始菜单快捷方式"
159. '       CmdAddProgram             "创建程序组下的快捷方式"
160. '       CmdQuickLaunch            "创建快捷工具栏的快捷方式"
161. '       CmdDelAllLink             "删除所有快捷方式"
162. '-----------------------------------------------------
163. '要在VB中创建Windows的快捷方式，需要用到VB的一个动态链接库
164. 'Vb5stkit.dll。在该动态链接库中提供了三个函数
165. 'OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink
166. '分别用于创建快捷方式程序组、创建快捷方式和删除快捷方式。
167. '-----------------------------------------------------
169. Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" _
170.         Alias "fCreateShellFolder" (ByVal lpstrDirName As String) As Long
171.         
172. 'lpstrDirName指定了程序组的名称
173. '-----------------------------------------------------
175. Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" _
176.         Alias "fCreateShellLink" (ByVal lpstrFolderName As String, _
177.         ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
178.         
179. 'lpstrfoldername指定保存快捷方式的文件夹
180. 'lpstrlinkname指定快捷方式的文件名
181. 'lpstrLinkpathe指定快捷方式所指向的应用程序或文件
182. 'lpstrLinkArguments是程序运行所需的参数
183. '-----------------------------------------------------
185. Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" Alias _
186.         "fRemoveShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As Long
188. '获取Windows目录
189. Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
190.                           "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
192. '获得文件夹路径
193. 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
195. Private Const Max_Path = 260       '缓冲区大小
196. Private Const CSIDL_PROGRAMS = &H2 '程序组常量
198. '*************************************************************************
199. '**函 数 名： GetWindowsPath
200. '**输    入： 无
201. '**输    出： (String) -
202. '**功能描述： 得到Windows路径
203. '**全局变量：
204. '**调用模块：
205. '**作    者： Mr.David
206. '**日    期： 2006-09-19 19:49:17
207. '**修 改 人：
208. '**日    期：
209. '**版    本： V1.0.0
210. '*************************************************************************
212. Public Function GetWindowsPath() As String
214.     Dim ChrLen As Long, WinDir As String
216.     WinDir = Space$(Max_Path)
217.     ChrLen = GetWindowsDirectory(WinDir, Max_Path)
219.     WinDir = Left$(WinDir, ChrLen)
220.     GetWindowsPath = WinDir
222. End Function
224. '*************************************************************************
225. '**函 数 名： GetProgarmPath
226. '**输    入： frmHwnd(Long) -
227. '**输    出： (String) -
228. '**功能描述： 获取开始菜单程序组的路径
229. '**全局变量：
230. '**调用模块：
231. '**作    者： Mr.David
232. '**日    期： 2006-09-19 19:48:16
233. '**修 改 人：
234. '**日    期：
235. '**版    本： V1.0.0
236. '*************************************************************************
238. Public Function GetProgarmPath(frmHwnd As Long) As String
240.     Dim CSILD_NUM As Long, strBouff As String
242.     strBouff = String$(Max_Path, 0)
244.     SHGetSpecialFolderPath frmHwnd, strBouff, CSIDL_PROGRAMS, 0
245.     GetProgarmPath = Left$(strBouff, InStr(1, strBouff, Chr$(0)) - 1)
247. End Function
249. 方法3
251. 先引用系统里面都有的WSHom.Ocx
253. Option Explicit
255. '*************************************************************************
256. '**函 数 名： SetAutoRun
257. '**输    入： ByVal Autorun(Boolean) -
258. '**输    出： 无
259. '**功能描述： 随WINDOWS自动启动/取消启动模块
260. '**全局变量：
261. '**调用方法： Call SetAutoRun(True/False)
262. '**作    者： Mr.David
263. '**日    期： 2006-09-05 09:07:25
264. '**修 改 人：
265. '**日    期：
266. '**版    本： V1.0.0
267. '*************************************************************************
269. Public Sub SetAutoRun(ByVal Autorun As Boolean)
270.     
271.     'WshShell 对象
272.     'ProgId Wscript.Shell
273.     '文件名 WSHom.Ocx
274.     
275.     Dim WshShell As WshShell
276.     
277.     Set WshShell = CreateObject("Wscript.Shell")
278.     
279.     If Autorun Then
281.         WshShell.RegWrite "HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Run/" & App.EXEName, App.Path & "/" & App.EXEName & ".exe"
283.     Else
285.         WshShell.RegDelete "HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Run/" & App.EXEName
287.     End If
288.     
289.     Set WshShell = Nothing
290.     
291. End Sub