Access911.net   |   a9BBS   |   OTaA System  
  搜索文章:  
Access911欢迎您光临  
   主页      上传      繁體版       论坛     
设为首页  |  加入收藏   
  
你现在的位置:文章索引 -> 文章分类 -> 其他  
 首页|  近日更新|  下载  |  文章索引  |  搜索|  术语|  承接工程|  
 
系统正在加载内容,请耐心等待...
 
 查询
 窗体
 报表
 
 
 VBA
 函数
 ADO/DAO/ADO.NET
 API
 ADP
 安全
 发布
 OA
 ASP/ASP.NET
 其他语言
 控件
 DELPHI
 C#/.Net
 本站
 其他
 小例程
 常用软件
 参考文档
 业主作品
 网友大作
 
 
友情链接
 access911.net
 
访问人次
 1702080
 
站长 E-Mail
 net911@sina.com
 access911@gmail.com
 
RSS 订阅

显示附加信息 >>>

ACCESS 如何读写注册表?

作者:cg1  摘自:access911.net  :cg1  更新日期:2005-8-28  浏览人次:

 

方法一:

方法非常多
可以直接将要修改的键值保存为一个 *.reg 文件,用注册表编辑器导出某一键值就可以自动生成对应的 *.REG 文件。然后用 shell 去运行 regedit /s c:\a.reg 即可
Shell "regedit /s c:\c.reg"

 

方法二:

使用 WSH 的 RegRead、RegWrite方法来读写
Function SetTypeAQuestionForHelpBox()
'本函数调用 WSH 来修改注册表达到去掉 OFFICE 组件右上角提问框的目的
    '请先到 菜单 -> 工具 -> 引用 中去引用如下类库:
    'Windows Script Host Object Model

    On Error Resume Next    
    Dim a As New WshShell
    '如果采用后引用方式,也可以写如下代码:
    'Set a = CreateObject("WScript.Shell")
    
    '显示提问框,键入需要帮助的问题 这个框的设置选项是在注册表中的一下键位
    'HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\ToolBars\Settings\Microsoft Office Access AWDropdownHidden
    '先显示键的值。注意:如果你从来没有手动设置过“显示提问框”这个选项就没有以下键值。
    '因此以下这行会出错。前面已经使用过 On Error Resume Next 可以忽略该错误。

    Debug.Print a.RegRead("HKCU\Software\Microsoft\Office\11.0\Common\ToolBars\Settings\Microsoft Office Access AWDropdownHidden")
    '再修改它(或者建立该键,并赋值)
    a.RegWrite "HKCU\Software\Microsoft\Office\11.0\Common\ToolBars\Settings\Microsoft Office Access AWDropdownHidden", 1, "REG_DWORD"
End Function

 

方法三:

如果不使用 WSH 如何修改和读取注册表?
    在VB中,我们还可以直接使用Win32SDK下相关的注册表API来修改和读取注册表。
具体方法为:
  a.对所要调用的API函数进行声明
如:
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

 b.调用该API函数,操作注册表

 c.具体例子:
Option Explicit 
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 

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" 
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 

Sub Main() 
Dim ret As Long, hKey As Long, hKey2 As Long 
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey) 
If ret = 0 Then 
MsgBox "HKLM\SOFTWARE\Microsoft = " & hKey 
End If 

ret = RegOpenKey(hKey, "Windows\CurrentVersion", hKey2) 
If ret = 0 Then 
MsgBox "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = " & hKey2 
End If 
'Use RegCreateKey function to create subkey "HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt"
ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)
If Not ret Then 
MsgBox "Create HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt SubKey Success" 
Else
MsgBox "Create Subkey Operation Fail" 
End If 

RegCloseKey hKey 
RegCloseKey hKey2 
End Sub


下面是一篇关于如何使用Win32SDK去操作注册表的联机帮助,希望对您有所帮助:
Title: Platform SDK: Windows System Information----Registry
URL: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/regcreatekey.asp

 

方法三:

这里还有一个其他网站总结好的模块,摘自:http://www.chinaaspx.com/archive/VB/19324.htm

用API修改注册表的完整模块 
 
 
有些老掉牙了,这是很久以前写的了,觉得功能已经比较完善了。

下载地址:
http://www.wowor.net/bbs/up/files/2004403_mregistry.zip

这是我用这个模块写过的一个软件:

注册表大师 2.0

http://www.onlinedown.net/soft/16780.htm

标准模块代码:
'**************************************************************************************************************
'* 本模块提供了一些对注册表进行操作的函数
'* 警告: 操作注册表是非常危险的, 使用本模块中的任何函数都要慎重!!!
'*
'* 版权: LPP软件工作室
'* 作者: 卢培培
'**************************************************************************************************************

Option Explicit

Option Compare Text

'---------------------------------------------------------------
'- 注册表 API 声明...
'---------------------------------------------------------------

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private 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
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long          'Returns a valid LUID which is important when making security changes in NT.
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

'---------------------------------------------------------------
'- 注册表 Api 常数...
'---------------------------------------------------------------
' 注册表创建类型值...

Const REG_OPTION_NON_VOLATILE = 0        ' 当系统重新启动时,关键字被保留

' 注册表关键字安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                     
' 返回值...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0

' 有关导入/导出的常量
Const REG_FORCE_RESTORE As Long = 8&
Const TOKEN_QUERY As Long = &H8&
Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Const SE_PRIVILEGE_ENABLED As Long = &H2
Const SE_RESTORE_NAME = "SeRestorePrivilege"
Const SE_BACKUP_NAME = "SeBackupPrivilege"

'---------------------------------------------------------------
'- 注册表类型...
'---------------------------------------------------------------

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges As LUID_AND_ATTRIBUTES
End Type

'---------------------------------------------------------------
'- 自定义枚举类型...
'---------------------------------------------------------------
' 注册表数据类型...

Public Enum ValueType
    REG_SZ = 1                         ' 字符串值
    REG_EXPAND_SZ = 2                  ' 可扩充字符串值
    REG_BINARY = 3                     ' 二进制值
    REG_DWORD = 4                      ' DWORD值
    REG_MULTI_SZ = 7                   ' 多字符串值
End Enum

' 注册表关键字根类型...
Public Enum KeyRoot
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

Private hKey As Long                   ' 注册表打开项的句柄
Private i As Long, j As Long           ' 循环变量
Private Success As Long                ' API函数的返回值, 判断函数调用是否成功

'-------------------------------------------------------------------------------------------------------------
'- 新建注册表关键字并设置注册表关键字的值...
'- 如果 ValueName 和 Value 都缺省, 则只新建 KeyName 空项, 无子键...
'- 如果只缺省 ValueName 则将设置指定 KeyName 的默认值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, Value--值项数据, ValueType--值项类型
'-------------------------------------------------------------------------------------------------------------
Public Function SetKeyValue(KeyRoot As KeyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = "", Optional ValueType As ValueType = REG_SZ) As Boolean
    Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类型
    lpAttr.nLength = 50                                 ' 设置安全属性为缺省值...
    lpAttr.lpSecurityDescriptor = 0                     ' ...
    lpAttr.bInheritHandle = True                        ' ...
    
    ' 新建注册表关键字...
    Success = RegCreateKeyEx(KeyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)
    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
    
    ' 设置注册表关键字的值...
    If IsMissing(ValueName) = False Then
        Select Case ValueType
            Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
                Success = RegSetValueEx(hKey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
            Case REG_DWORD
                If CDbl(Value) <= 4294967295# And CDbl(Value) >= 0 Then
                    Dim sValue As String
                    sValue = DoubleToHex(Value)
                    Dim dValue(3) As Byte
                    dValue(0) = Format("&h" & Mid(sValue, 7, 2))
                    dValue(1) = Format("&h" & Mid(sValue, 5, 2))
                    dValue(2) = Format("&h" & Mid(sValue, 3, 2))
                    dValue(3) = Format("&h" & Mid(sValue, 1, 2))
                    Success = RegSetValueEx(hKey, ValueName, 0, ValueType, dValue(0), 4)
                Else
                    Success = ERROR_BADKEY
                End If
            Case REG_BINARY
                On Error Resume Next
                Success = 1                             ' 假设调用API不成功(成功返回0)
                ReDim tmpValue(UBound(Value)) As Byte
                For i = 0 To UBound(tmpValue)
                    tmpValue(i) = Value(i)
                Next i
                Success = RegSetValueEx(hKey, ValueName, 0, ValueType, tmpValue(0), UBound(Value) + 1)
        End Select
    End If
    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
    
    ' 关闭注册表关键字...
    RegCloseKey hKey
    SetKeyValue = True                                       ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 获得已存在的注册表关键字的值...
'- 如果 ValueName="" 则返回 KeyName 项的默认值...
'- 如果指定的注册表关键字不存在, 则返回空串...
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, ValueType--值项类型
'-------------------------------------------------------------------------------------------------------------

Public Function GetKeyValue(KeyRoot As KeyRoot, KeyName As String, ValueName As String, Optional ValueType As Long) As String
    Dim TempValue As String                             ' 注册表关键字的临时值
    Dim Value As String                                 ' 注册表关键字的值
    Dim ValueSize As Long                               ' 注册表关键字的值的实际长度
    TempValue = Space(1024)                             ' 存储注册表关键字的临时值的缓冲区
    ValueSize = 1024                                    ' 设置注册表关键字的值的默认长度
    
    ' 打开一个已存在的注册表关键字...
    RegOpenKeyEx KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey
    
    ' 获得已打开的注册表关键字的值...
    RegQueryValueEx hKey, ValueName, 0, ValueType, ByVal TempValue, ValueSize
    
    ' 返回注册表关键字的的值...
    Select Case ValueType                                                        ' 通过判断关键字的类型, 进行处理
        Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
            TempValue = Left$(TempValue, ValueSize - 1)                          ' 去掉TempValue尾部空格
            Value = TempValue
        Case REG_DWORD
            ReDim dValue(3) As Byte
            RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue(0), ValueSize
            For i = 3 To 0 Step -1
                Value = Value + String(2 - Len(Hex(dValue(i))), "0") + Hex(dValue(i))   ' 生成长度为8的十六进制字符串
            Next i
            If CDbl("&H" & Value) < 0 Then                                              ' 将十六进制的 Value 转换为十进制
                Value = 2 ^ 32 + CDbl("&H" & Value)
            Else
                Value = CDbl("&H" & Value)
            End If
        Case REG_BINARY
            If ValueSize > 0 Then
                ReDim bValue(ValueSize - 1) As Byte                                     ' 存储 REG_BINARY 值的临时数组
                RegQueryValueEx hKey, ValueName, 0, REG_BINARY, bValue(0), ValueSize
                For i = 0 To ValueSize - 1
                    Value = Value + String(2 - Len(Hex(bValue(i))), "0") + Hex(bValue(i)) + " "  ' 将数组转换成字符串
                Next i
            End If
    End Select
    
    ' 关闭注册表关键字...
    RegCloseKey hKey
    GetKeyValue = Trim(Value)                                                    ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 删除已存在的注册表关键字的值...
'- 如果指定的注册表关键字不存在, 则不做任何操作...
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称
'-------------------------------------------------------------------------------------------------------------

Public Function DeleteKey(KeyRoot As KeyRoot, KeyName As String, Optional ValueName As String) As Boolean
    Dim tmpKeyName As String                            ' 注册表关键字的临时子项名称
    Dim tmpValueName As String                          ' 注册表关键字的临时子键名称
    
    ' 打开一个已存在的注册表关键字...
    Success = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
    If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hKey: Exit Function
    
    ' 删除已打开的注册表关键字...
    tmpKeyName = ""
    tmpValueName = KeyName
    If ValueName = "" Then                                              ' 判断ValueName是否缺省, 如缺省作相应处理
        If InStrRev(KeyName, "\") > 1 Then
            tmpValueName = Right(KeyName, InStrRev(KeyName, "\") + 1)
            tmpKeyName = Left(KeyName, InStrRev(KeyName, "\") - 1)
        End If
        Success = RegOpenKeyEx(KeyRoot, tmpKeyName, 0, KEY_ALL_ACCESS, hKey)
        Success = RegDeleteKey(hKey, tmpValueName)
    Else
        Success = RegDeleteValue(hKey, ValueName)
    End If
    If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hKey: Exit Function
    
    ' 关闭注册表关键字...
    RegCloseKey hKey
    DeleteKey = True                                    ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 获得注册表关键字的一些信息...
'- SubKeyName()      注册表关键字的所有子项的名称(注意:最小下标为0)
'- ValueName()       注册表关键字的所有子键的名称(注意:最小下标为0)
'- ValueType()       注册表关键字的所有子键的类型(注意:最小下标为0)
'- CountKey          注册表关键字的子项数量
'- CountValue        注册表关键字的子键数量
'- MaxLenKey         注册表关键字的子项名称的最大长度
'- MaxLenValue       注册表关键字的子键名称的最大长度
'-------------------------------------------------------------------------------------------------------------

Public Function GetKeyInfo(KeyRoot As KeyRoot, KeyName As String, SubKeyName() As String, ValueName() As String, ValueType() As ValueType, Optional CountKey As Long, Optional CountValue As Long, Optional MaxLenKey As Long, Optional MaxLenValue As Long) As Boolean
    Dim f As FILETIME
    Dim l As Long, s As String
    
    ' 打开一个已存在的注册表关键字...
    Success = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
    If Success <> ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function
    
    ' 获得一个已打开的注册表关键字的信息...
    Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)
    If Success <> ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function
    
    If CountKey <> 0 Then
        ReDim SubKeyName(CountKey - 1) As String            ' 重新定义数组, 使用数组大小与注册表关键字的子项数量匹配
        For i = 0 To CountKey - 1
            SubKeyName(i) = Space(255)
            l = 255
            RegEnumKeyEx hKey, i, ByVal SubKeyName(i), l, 0, vbNullString, ByVal 0&, f
            SubKeyName(i) = Left(SubKeyName(i), l)
        Next i
        
        ' 下面的二重循环对字符串数组进行冒泡排序
        For i = 0 To UBound(SubKeyName)
            For j = i + 1 To UBound(SubKeyName)
                If SubKeyName(i) > SubKeyName(j) Then
                    s = SubKeyName(i)
                    SubKeyName(i) = SubKeyName(j)
                    SubKeyName(j) = s
                End If
            Next j
        Next i
    End If
    
    If CountValue <> 0 Then
        ReDim ValueName(CountValue - 1) As String           ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配
        ReDim ValueType(CountValue - 1) As Long             ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配
        For i = 0 To CountValue - 1
            ValueName(i) = Space(255)
            l = 255
            RegEnumValue hKey, i, ByVal ValueName(i), l, 0, ValueType(i), ByVal 0&, ByVal 0&
            ValueName(i) = Left(ValueName(i), l)
        Next i
        
        ' 下面的二重循环对字符串数组进行冒泡排序
        For i = 0 To UBound(ValueName)
            For j = i + 1 To UBound(ValueName)
                If ValueName(i) > ValueName(j) Then
                    s = ValueName(i)
                    ValueName(i) = ValueName(j)
                    ValueName(j) = s
                End If
            Next j
        Next i
    End If
    
    ' 关闭注册表关键字...
    RegCloseKey hKey
    GetKeyInfo = True                                   ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 导出注册表关键字的值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导出的文件路径及文件名(原始数据库格式)
'-------------------------------------------------------------------------------------------------------------

Public Function SaveKey(KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean
    On Error Resume Next
    
    Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类型
    lpAttr.nLength = 50                                 ' 设置安全属性为缺省值...
    lpAttr.lpSecurityDescriptor = 0                     ' ...
    lpAttr.bInheritHandle = True                        ' ...
    
    If EnablePrivilege(SE_BACKUP_NAME) = False Then
        SaveKey = False
        Exit Function
    End If
    
    Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hKey)
    If Success <> 0 Then
        SaveKey = False
        Success = RegCloseKey(hKey)
        Exit Function
    End If
    
    Success = RegSaveKey(hKey, FileName, lpAttr)
    If Success = 0 Then SaveKey = True Else SaveKey = False
    
    Success = RegCloseKey(hKey)
End Function

'-------------------------------------------------------------------------------------------------------------
'- 导入注册表关键字的值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导入的文件路径及文件名(原始数据库格式)
'-------------------------------------------------------------------------------------------------------------

Public Function RestoreKey(KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean
    On Error Resume Next
    
    If EnablePrivilege(SE_RESTORE_NAME) = False Then
        RestoreKey = False
        Exit Function
    End If
    
    Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hKey)
    If Success <> 0 Then
        RestoreKey = False
        Success = RegCloseKey(hKey)
        Exit Function
    End If
    
    Success = RegRestoreKey(hKey, FileName, REG_FORCE_RESTORE)
    If Success = 0 Then RestoreKey = True Else RestoreKey = False
    
    Success = RegCloseKey(hKey)
End Function

'-------------------------------------------------------------------------------------------------------------
'- 使注册表允许导入/导出
'-------------------------------------------------------------------------------------------------------------

Private Function EnablePrivilege(seName As String) As Boolean
    On Error Resume Next
    
    Dim p_lngRtn As Long
    Dim p_lngToken As Long
    Dim p_lngBufferLen As Long
    Dim p_typLUID As LUID
    Dim p_typTokenPriv As TOKEN_PRIVILEGES
    Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
    
    p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken)
    If p_lngRtn = 0 Then
        EnablePrivilege = False
        Exit Function
    End If
    If Err.LastDllError <> 0 Then
        EnablePrivilege = False
        Exit Function
    End If
    
    p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)
    If p_lngRtn = 0 Then
      EnablePrivilege = False
      Exit Function
    End If
    
    p_typTokenPriv.PrivilegeCount = 1
    p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
    p_typTokenPriv.Privileges.pLuid = p_typLUID
    
    EnablePrivilege = (AdjustTokenPrivileges(p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0)
End Function

'-------------------------------------------------------------------------------------------------------------
'- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零
'- 参数说明: Number--要转换的 Double 型数字
'-------------------------------------------------------------------------------------------------------------

Private Function DoubleToHex(ByVal Number As Double) As String
    Dim strHex As String
    strHex = Space(8)
    For i = 1 To 8
        Select Case Number - Int(Number / 16) * 16
            Case 10
                Mid(strHex, 9 - i, 1) = "A"
            Case 11
                Mid(strHex, 9 - i, 1) = "B"
            Case 12
                Mid(strHex, 9 - i, 1) = "C"
            Case 13
                Mid(strHex, 9 - i, 1) = "D"
            Case 14
                Mid(strHex, 9 - i, 1) = "E"
            Case 15
                Mid(strHex, 9 - i, 1) = "F"
            Case Else
                Mid(strHex, 9 - i, 1) = CStr(Number - Int(Number / 16) * 16)
        End Select
        Number = Int(Number / 16)
    Next i
    DoubleToHex = strHex
End Function

'access911: 有一段修改注册表的调用代码如下:
Private Sub Command1_Click()
    Dim s As String
    s = "00000000000000010003C6685CAB60C400005208000249F0000443685CAF6BEC" '修改了一下你的字串,凑够了32个字节
    Dim buff() As Byte
    Dim i As Long
    i = Len(s)
    If (i Mod 2) = 1 Then
        s = "0" & s
    End If
    i = Len(s)
    ReDim buff(i / 2 - 1)
    Dim j As Long
    For i = 0 To UBound(buff)
        j = UBound(buff) - i
        buff(j) = Val("&H" + Mid(s, 2 * i + 1, 2))
    Next
    SetKeyValue HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Print\Forms", "test1", buff, REG_BINARY
End Sub


 

 
 
 
 

 

 
相关文章
     没有手动相关文章
     如何写注册表限次?如何做到限制使用要注册后才能正常使用?
 
评论
     查看或发表更多的评论,请单击这里。
 
 
 
 
 
   
  Access911.net   |   a9BBS   |   OTaA System   |
建站日期:2000年4月2日  |  设计施工:陈格 ( access911 & cg1 )
 Copyright © 2000 - 2003 COMET, 陈格 保留所有权利