使用API函数修改注册表
为了让自己的程序成为自动启动需要修改注册表。下面事例可以供参考
Option Explicit
Const REG_SZ = 1
Global Const HKEY_LOCAL_MACHINE = &H80000002
Public Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
'该函数用于打开系统注册表中已存在的键函数的返回值：键打开成功返回0，否则返回非0，phkResult被设置为该键的句柄。
Public Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpszValueName As String, _
ByVal dwReserved As Long, ByVal fdwType As Long, _
lpbData As Any, ByVal cbData As Long) As Long
'该函数用于向系统注册表中指定的键添加键名和键值。函数的返回值： 添加键名、键值成功返回0，否则返回非0。
Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'该函数用于关闭系统注册表中打开的键。函数的返回值：键关闭成功返回0，否则返回非0。
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal lpValueName As String) As Long
'该函数用于删除注册表中打开键的键值
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String) As Long
'该函数用于删除注册表中打开的键
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'该函数用来在打开的键下创建新的键
Sub Main()
Dim hKey As Long, Key As String
Dim lResult As Long
On Error GoTo RegSet_Err
Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
lResult = RegOpenKey(HKEY_LOCAL_MACHINE, _
Key, hKey)
If lResult <> 0 Then
Err.Raise 10001, , "打开注册表项失败"
End If
lResult = RegSetStringValue(hKey, "MyAcess", "d:\programfiles\office97\" & _
"office\mymsaccess.exe", False)
If lResult = 0 Then
Err.Raise 10001, , "打开注册表项失败"
End If
'如果flag为True,则该动作将被记录在日志文件中，并且卸载程序时该值将被删除。
lResult = RegDeleteValue(hKey, "MyAcess")
lResult = RegCreateKey(hKey, "test", lResult)
lResult = RegDeleteKey(hKey, "test")
RegCloseKey (hKey)
Exit Sub
RegSet_Err:
MsgBox Err.Description, vbExclamation, "设置注册表"
End Sub
Function RegSetStringValue(ByVal hKey As Long, ByVal strValueName As String, _
ByVal strData As String, Optional ByVal flog) As Boolean
Dim lResult As Long
On Error Resume Next
lResult = RegSetValueEx(hKey, strValueName, 0&, REG_SZ, ByVal strData, LenB(StrConv(strData, vbFromUnicode)) + 1)
'StrConv(strData,vbFromUnicode)的作用是：根据将字符串转换成Unicode。
If lResult = 0 Then
RegSetStringValue = True
Else
RegSetStringValue = False
End If
End Function
