[原创]VB的注册表处理函数

由于VB没直接新建注册表的函数，所以本人写了四个API函数，用于直接对注册表操作，请指教！

我的QQ：328266362

EMAIL：stmp@163.com

'----------------------------------------------------------------------------
'这个模块通API函数定义了方便的注册表处理函数,后两个函数用于写入注册表自动运行项，实现开机自动运行
'1  建立注册表键值函数: RegWrite(主键名，键值目录，键名，键值）
'2. 册除注册表函数：RegDelete(主键名，键值目录，键名)
'3. SaveRunKey(键名，键值）
'4. DeleteRunKey(键名)

'其中主键名为数值型，可以直接通常量定义，其余的值是STRING字符型
'当返回TRUE时，为操作成功，否则False 失败。
'例子
'Dim HK_Main As Long
'Dim SubKeyPath As String
'Dim SubKeyName As String
'Dim SubKeyVaule As String
'HK_Main = HKEY_LOCAL_MACHINE
'SubKeyPath = "Software/Microsoft/Windows/CurrentVersion/Run"
'SubKeyName = "MyAcess"
'SubKeyVaule = "d:/programfiles/office97/office/mymsaccess.exe"
'If RegWrite(HK_Main, SubKeyPath, SubKeyName, SubKeyVaule) Then .........

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Const REG_SZ = 1

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'它的参数用法与RegOpenKey一样。
'所不同的是RegOpenKey只能打开已经有的SubKey,而RegCreateKey则可以建立SubKey,
'比较特别的是，如果调用RegCreateKey所建立的SubKey是一个已经存在的SubKey,则它的功能和RegOpenKey相同。
'由于RegCreateKey的这种特性，有的程序员干脆不用RegOpenKey，而用RegCreateKey来统一代替RegOpenKey。

Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
'该函数用于打开系统注册表中已存在的键。函数的返回值：键打开成功返回0，否则返回非0，phkResult被设置为该键的句柄。

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。

Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'该函数用于关闭系统注册表中打开的键。函数的返回值：键关闭成功返回0，否则返回非0。
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'参数:
'hKey: Key Handle
'lpValueName: Value名称，如果想删除默认值的话，传入""[空字符串]即可。
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

Function oRegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean
  Dim lResult As Long
  On Error GoTo 0 '关闭错误陷阱
  'lResult = RegOpenKey(hKey, lpszSubKey, phkResult)   '我用 RegCreateKey 直接取代RegOpenKey
  lResult = RegCreateKey(hKey, lpszSubKey, phkResult)
  If lResult = 0 Then
    oRegOpenKey = True
  Else
    oRegOpenKey = False
  End If
End Function

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 GoTo 0
  lResult = RegSetValueEx(hKey, strValueName, 0&, REG_SZ, ByVal strData, LenB(StrConv(strData, vbFromUicode)) + 1)
'StrConv是Visual Basic提供的函数，返回按指定类型转换的Variant(String)。
'vbFromUicode是Visual Basic的系统常数。

'　　在上面程序中，StrConv(strData,vbFromUnicode)的作用是：根据系统的默认码将字符串转换成Unicode。

If lResult = 0 Then
RegSetStringValue = True
Else: RegSetStringValue = False
End If
End Function

Function RegCreate(ByVal HK_Main As Long, ByVal SubKeypath As String, ByVal subKeyName As String, SubKeyVaule As String)
Dim hKey As Long
Dim MyReturn As Long
'例如：
'HK_Main = HKEY_LOCAL_MACHINE
'SubKeyPath = "Software/Microsoft/Windows/CurrentVersion/Run"
'SubKeyName = "MyAcess"
'SubKeyVaule = "d:/programfiles/office97/office/mymsaccess.exe"
RegCreate = False
MyReturn = oRegOpenKey(HK_Main, SubKeypath, hKey)
If hKey = 0 Then
 'MsgBox "您要求打开的主键未创建，或者您的输入有误，请仔细核对后再次运行本程序！"
   Exit Function
End If
MyReturn = RegSetStringValue(hKey, subKeyName, SubKeyVaule, False)
'如果flag丢失或为True,则该动作将被记录在日志文件中，并且，如果用户选择删除已安装的应用程序，该值将被应用程序删除。

If MyReturn Then
 'MsgBox "您的程序已成功添加到Windows 98的启动中，再次启动Windows时系统将自动运行您的程序！", vbExclamation, "特别提示"
 RegCreate = True
Else
 'MsgBox "您的这段代码中存在某种错误，请认真检查！", vbExclamation, "特别提示"
End If
RegCloseKey (hKey)
End Function

Function RegDelete(HK_Main As Long, SubKeypath As String, subKeyName As String) As Boolean
RegDelete = False
ret = RegOpenKey(HK_Main, SubKeypath, hKey)
If ret = 0 Then
 ret = RegDeleteValue(hKey, subKeyName)
 If ret = 0 Then RegDelete = True
  'MsgBox "已删除" & SubKeyPath & SubKeyName & "的键值"
 'RegDeleteValue hKey, ""
 'MsgBox "已删除  " & SubKeyPath & SubKeyName & "预设值"
End If
RegCloseKey (hKey)
End Function

Function SaveRunKey(ByVal subKeyName As String, ByVal SubKeyVaule As String) As Boolean
Dim HK_Main As Long, SubKeypath As String
HK_Main = HKEY_LOCAL_MACHINE
SubKeypath = "Software/Microsoft/Windows/CurrentVersion/Run"
SaveRunKey = RegCreate(HK_Main, SubKeypath, subKeyName, SubKeyVaule)
End Function
Function DeleteRunKey(ByVal subKeyName As String) As Boolean
Dim HK_Main As Long, SubKeypath As String
HK_Main = HKEY_LOCAL_MACHINE
SubKeypath = "Software/Microsoft/Windows/CurrentVersion/Run"
DeleteRunKey = RegDelete(HK_Main, SubKeypath, subKeyName)
End Function