求教高手如何通过注册表把程序写入到启动项里,谢谢!!!

Question

求教高手如何通过注册表把程序写入到启动项里,谢谢!!!

Answer 1

Option Explicit
' 本模組程序是為操作系統注冊表用Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As LongPublic Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))Public Const ERROR_SUCCESS = 0&Public Const REG_SZ = 1
Public Const REG_DWORD = 4
Public Const REG_OPTION_NON_VOLATILE = 0' 獲取鍵值
Public Function GetValue(ProdeFinedKey As Long, ByVal KeyName As String, ByVal ValueName As String) As Variant
   Dim rc As Long, hKey As Long
   Dim lpData As String
   Dim lpType As Long
   Dim lpDataDWORD As Long
   Dim lenData As Long
   
   If Left$(KeyName, 1) = "\" Then
      KeyName = Mid(KeyName, 2)
   End If
   
   rc = RegOpenKeyEx(ProdeFinedKey, KeyName, 0, KEY_ALL_ACCESS, hKey)
   If rc = ERROR_SUCCESS Then
      ' 讀取字串型態
      rc = RegQueryValueEx(hKey, ValueName, 0, lpType, ByVal vbNullString, lenData)
      If rc = ERROR_SUCCESS Then
         Select Case lpType
            Case REG_SZ   ' 字串
               lpData = String(lenData, Chr(0))
               rc = RegQueryValueEx(hKey, ValueName, 0, lpType, ByVal lpData, lenData)
               If rc = 0 Then
                  GetValue = Left(lpData, InStr(lpData, Chr(0)) - 1)
               Else
                  GetValue = ""
               End If
            Case REG_DWORD
               rc = RegQueryValueEx(hKey, ValueName, 0, lpType, lpDataDWORD, 255)
               If rc = 0 Then
                  GetValue = CSng(lpDataDWORD)
               Else
                  GetValue = 0
               End If
         End Select
      End If
      RegCloseKey hKey
   End If
End FunctionPublic Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String) As Long
   Dim hNewKey As Long
   Dim lRetVal As Long
   
   lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
   CreateNewKey = lRetVal
   
   RegCloseKey (hNewKey)
End FunctionPublic Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
   Dim lRetVal As Long
   Dim hKey As Long
   
   lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
   If lRetVal <> ERROR_SUCCESS Then
      lRetVal = CreateNewKey(lPredefinedKey, sKeyName)
   End If
   
   lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
   RegCloseKey (hKey)
End FunctionPublic Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
   Dim lValue As Long
   Dim sValue As String
   
   Select Case lType
       Case REG_SZ
           sValue = vValue
           SetValueEx = RegSetValueExString(hKey, sValueName, 0, lType, ByVal Trim(sValue), IIf(LenB(sValue) = 0, 1, LenB(sValue)))
       Case REG_DWORD
           lValue = vValue
           SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
   End Select
End Function////////////////////////////////////////////////////
'設置/取消軟件自啟動
   Dim StrSubKey As String, StrExe As String
   Dim hKey As Long
   
   StrSubKey = "Software\Microsoft\Windows\CurrentVersion\Run"
   StrExe = App.Path & App.EXEName & ".exe"   RegOpenKey HKEY_LOCAL_MACHINE, StrSubKey, hKey
   
   If Me.chkStart.Value = 1 Then
      RegSetValueEx hKey, "我的測試軟件", 0, REG_SZ, ByVal StrExe, LenB(StrConv(StrExe, vbFromUnicode)) + 1
   Else
      RegDeleteValue hKey, "ListenEZ"
   End If
   
   RegCloseKey hKey
   

Answer 2

'哇，好长，简化一点~
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Sub Form_Load()
    Dim hKey As Long, iPath As String
    RegOpenKeyEx &H80000002, "Software\Microsoft\Windows\CurrentVersion\Run", 0, &H20006, hKey
    iPath = Replace(App.Path & "\", "\\", "\") & App.EXEName & ".exe"
    RegSetValueEx hKey, App.EXEName, 0, &H1, ByVal iPath, Len(iPath)
    RegCloseKey hKey
End Sub

Answer 3

可以考虑把 HKEY_LOCAL_MACHINE（&H80000002）改为 HKEY_CURRENT_USER（&H80000001），因为并不是所有的用户都有 administrator 或 power user 的权限。