使用API函数修改注册表

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