打印本文 打印本文 关闭窗口 关闭窗口
用API修改注册表的完整模块
作者:武汉SEO闵涛  文章来源:敏韬网  点击数2455  更新时间:2009/4/23 16:37:39  文章录入:mintao  责任编辑:mintao
--------------------------------------------------------------------------
''''- 新建注册表关键字并设置注册表关键字的值...
''''- 如果 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                                              '''' 将

上一页  [1] [2] [3] [4]  下一页

打印本文 打印本文 关闭窗口 关闭窗口