使用API函数修改注册表
来源:岁月联盟
时间:2005-08-18
为了让自己的程序成为自动启动需要修改注册表。下面事例可以供参考 Option Explicit Const REG_SZ = 1Global 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 SubRegSet_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