使用API函数修改注册表

使用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