開機運行程式
有兩種方法，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)
'**日 期： 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", "")
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 ●CSOL木馬網站●L_PROGRAMS = &H2 '程式組常量
'*************************************************************************
'**函 數 名： GetWindowsPath
'**輸 入： 無
'**輸 出： (String) -
'**功能描述： 得到Windows路徑
'**總體變數：
'**調用模組：
'**日 期： 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) -
'**功能描述： 獲取開始功能表程式組的路徑
'**總體變數：
'**調用模組：
'**日 期： 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$(str●嚴禁張貼私服●ouff, Chr$(0)) - 1)
End Function
方法3
先引用系統裏面都有的WSHom.Ocx
Option Explicit
'*************************************************************************
'**函 數 名： SetAutoRun
'**輸 入： ByVal Autorun(Boolean) -
'**輸 出： 無
'**功能描述： 隨WINDOWS自動啟動/取消啟動模組
'**總體變數：
'**調用方法： Call SetAutoRun(True/False)
'**日 期： 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
|
收藏
分享
讚
幹
分享
分享
