vb开机自动运行代码:VB实现程序开机自动运行来源: 发布时间:星期四, 2009年2月12日 浏览:336次 评论:0
VB开机运行是我们经常要用到,下面给出实现思路方法代码 有两种思路方法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 \'**修 改 人: \'**日 期: \'**版 本: V1.0.0 \'************************************************************************* 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\", \"\")[Page] 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在该动态链接库中提供了 3个 \'OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink \'分别用于创建快捷方式组、创建快捷方式和删除快捷方式 \'----------------------------------------------------- Declare Function OSfCreateShellGroup Lib \"Vb5stkit.dll\" _ Alias \"fCreateShellFolder\" (ByVal lpstrDirName As String) As Long \'lpstrDirName指定了组名称 \'-----------------------------------------------------[Page] 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 \'**修 改 人: \'**日 期: \'**版 本: V1.0.0 \'************************************************************************* 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) - \'**输 出: 无[Page] \'**功能描述: 随WINDOWS自动启动/取消启动模块 \'**全局变量: \'**思路方法: Call SetAutoRun(True/False) \'**作 者: Mr.David \'**日 期: 2006-09-05 09:07:25 \'**修 改 人: \'**日 期: \'**版 本: V1.0.0 \'************************************************************************* 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 1
相关文章读者评论发表评论 |