VB开机运行程序
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 = '************************************************************************* Public Sub SetAutoRun(ByVal Autorun As Boolean) Dim KeyId As Long regkey = "Software/Microsoft/Windows/CurrentVersion/Run" '键值位置变量 Call RegCreateKey(HKEY_LOCAL_MACHINE,regkey,KeyId) '建立 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)
'窗体部分代码,加入6个按钮 Option Explicit Private Sub CmdAddStartup_Click() '在开始菜单的启动程序组下创建记事本的快捷方式 Call OSfCreateShellLink("/启动","记事本",GetWindowsPath & "/Notepad.exe","") End Sub Private Sub CmdAddDeskTop_Click() '在桌面创建记事本的快捷方式 Call OSfCreateShellLink("../../桌面","") End Sub Private Sub CmdAddProgram_Click() '在程序菜单的Notepad程序组下创建记事本的快捷方式 Call OSfCreateShellGroup("Notepad") '先建立程序组 Call OSfCreateShellLink("Notepad","") End Sub Private Sub CmdAddStartMenu_Click() Dim i As Long For i = 1 To 5 '在开始菜单创建记事本的快捷方式,必须用循环才能创建? Next End Sub Call OSfCreateShellLink("../../Application Data/Microsoft/Internet Explorer/Quick Launch","") End Sub Private Sub CmdDelAllLink_Click() Call OSfRemoveShellLink("../../「开始」菜单","记事本") '删除开始菜单上的快捷方式 Call OSfRemoveShellLink("../../桌面","记事本") '删除桌面上的快捷方式 'Call OSfRemoveShellLink("Notepad","记事本") '删除Notepad程序组下的快捷方式,这样不能删除程序组 Call OSfRemoveShellLink("/启动","记事本") '删除启动菜单下的快捷方式 Call OSfRemoveShellLink("../../Application Data/Microsoft/Internet Explorer/Quick Launch","记事本") '删除快捷工具栏下的快捷方式 End Sub Private Sub RemoveShellGroup() On Error GoTo ToExit '打开错误陷阱 '------------------------------------------------ 'RmDir删除一个存在的目录或文件夹。语法RmDir Path Kill (GetProgarmPath(Me.hWnd) & "/Notepad/记事本.lnk") '------------------------------------------------ Exit Sub '---------------- ToExit: Resume Next End Sub '模块代码 Option Explicit '----------------------------------------------------- Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" _ Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" _ Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" Alias _ '获取Windows目录 '获得文件夹路径 Private Const Max_Path = 260 '缓冲区大小 '************************************************************************* Public Function GetWindowsPath() As String Dim ChrLen As Long,WinDir As String WinDir = Space$(Max_Path) WinDir = Left$(WinDir,ChrLen) End Function '************************************************************************* 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 End Function 方法3 先引用系统里面都有的WSHom.Ocx Option Explicit '************************************************************************* Public Sub SetAutoRun(ByVal Autorun As Boolean) 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 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |