如何读写注册表？

。

解决方案 »

  1.   


        VB修改注册表一特例
     
    　我们知道,在VB中调用Windows的API函数能比较方便的修改系统注目表,然而笔者近来在一次应用中偶然发现这样一个特殊的问题:若在注目表HKEY_LOCAL_MACHINE\Mircrosoft\Windows \CurrentVersion\Setup下有一双字节型串值SetupOnce为"0x7cf70b"现要通过VB把其改为"0xffffffff"(十进制为4294967295)。是不是直接定义长整型变量Updata,并赋值Updata=4294967295,然后调用API函数RegSetValueEx
    ("HKEY_LOCAL_MACHINE", "Software\Mircrosoft \Windows\CurrentVersion\Setup","SetupOnce",0,4,Updata,4)就能达到目的呢?实际非也!这样操作,将会出错,出错报告为"实时错误6,溢出"。问题出在那里呢?笔者经过思考,发现十六进制0xffffffff化为十进制4294967295共十位数,显然把变量Updata在定义为长整型时存在错误。知道了问题所在,我们把Updata变量重新定义为双精度型,接下来的问题是Updata到底应赋予何值?我们可以采用反推法,即先在注册表中先令SetupOnce为"0xffffffff",在VB中定义变量Updata(double型),调用API中注册表查询库函数RegQueryValueEx("HKEY_LOCAL_MACHINE","Software\Mircrosoft\Windows \CurrentVersion \Setup","SetupOnce",0,4,Updata,4)在VB中一调试,结果出来了,Up!data的值为2.12199579047121E-314(这个数字真有点吓人)。知道了Updata的取值我们就可以用RegSetValueEx函数修改原来
    SetupOnce的值了。下面给出以上所述过程的一个例程,希望对您有所启发。
    　　新建一工程,在此工程声明段声明常量及API库函数:
    PrivateDeclareFunction RegCloseKey Lib "advapi32.dll" (ByVal hKey AsLong)As Long
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey AsString, 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 lpValueNameAs String, ByVal lpReserved As Long,lpType As Long, lpDataAs Any, lpcbData As Long) As Long'Note that if you declarethe lpData parameter as String, youmust pass it By Value.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,lpDataAs Any, ByVal cbData As Long) As Long'Note that ifyou declarethe lpData parameter as String, you must pass itBy Value.Const HKEY_LOCAL_MACHINE = &H80000002 Const REG_DWORD =4 Const ERROR_SUCCESS = 0& Const KEY_ALL_ACCESS = &H3F ConstA = 2.12199579047121E-314 Const reg1 = "software \microsoft\windows \currentversion\setup"Public phkresult As Long在Form的Click事件中添加以下代码:
    Private Sub Form_Click() Dim back As Long Dim Updata As Double back = RegOpenKeyEx(HKEY_LOCAL_MACHINE, reg1, 0&,KEY_ALL_ACCESS,phkresult) back = RegQueryValueEx(phkresult,"SetupOnce", 0,REG_DWORD, Updata, 4)'如果要用RegQueryValueEx()读出某一值,函数调用前必须以KEY_QUERY_VALUE参数形式打开,实例中以KEY_ALL_ACCESS参数打开,实际上已包含了KEY_QUERY_VALUE。If back = ERROR_SUCCESS Then If Updata <> A Then Updata = A back = RegSetValueEx (phkresult, "SetupOnce", 0&,REG_DWORD,Updata, 4) If back = ERROR_SUCCESS Then
    MsgBox "标记成功!"Else MsgBox "标记不成功!"
    Exit Sub
    End If
    Else MsgBox "要标记的项已是所需" RegCloseKey(phkresult)
    Exit Sub
    End If
    Else Msgbox "注册表中无所需修改的项" End If RegCloseKey(phkresult)
    End Sub
    其实,以上例程完全可以用做加密技术。国内某个带"霸"字的软件亦采用了类似的加密技术,当然,只是在加密的表现结果上表现而已。 
     
       
    　
      
     
      

  2.   


        如何取得与设定、删除Registry内的值
     
    作者: 王国荣　　　程式启动时，会在 "HKEY_LOCAL_MACHINE\kj\Registry" Subkey 底下写入：(此时
    会呼叫 SetDefaultValue 及 SetValue 函数)        资料类型        名称            资料
            =========       ==============  ================================
                            (预设值)        kj Registry Master
            REG_SZ          StringData      这是字串
            REG_MULTI_SZ    MultiString     字串一(0) +字串二+Chr(0) +Chr(0)
            REG_DWORD       LongData        99999
            REG_BINARY      BinaryData      11 22 33 44 AA BB CC DD　　接着当您按下「显示所有 Value 时」(command1)时，程式会读出来所有 Value 并且
    　　显示在ListBox 之中(此时会呼叫 GetDefaultValue、GetValueByIndex 函数)。　　最後当程式结束时，则会删除以上所有的 Value(此时会呼叫 GetValueByIndex 函数
    及 RegDeleteValue API 函数)。'请放3个CommandBox一个ListBox於form上Option Explicit
    '
    Private Sub Form_Load()
        Dim hKey As Long, ret As Long    ret = SetDefaultValue(HKEY_LOCAL_MACHINE, "SOFTWARE\kj\Registry", _
                           "kj Registry Master")
        ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\kj\Registry", hKey)    ret = SetValue(hKey, "StringData", REG_SZ, "这是字串")
        ret = SetValue(hKey, "MultiString", REG_MULTI_SZ, "字串一" + Chr(0) _
              + "字串二" + Chr(0))
        ret = SetValue(hKey, "LongData", REG_DWORD, 99999)
        ret = SetValue(hKey, "BinaryData", REG_BINARY, _
                        Array(&H11, &H22, &H33, &H44, &HAA, &HBB, &HCC, &HDD), 8)
        Call RegCloseKey(hKey)
        MsgBox "已写入资料到登录资料库中，您可以开启 RegEdit 加以检查！"
    End SubPrivate Sub Command1_Click() ' 显示所有 Value
        Dim Index As Long, ret As Long, hKey As Long
        Dim bArr() As Byte, Name As String, vType As Long    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\kj\Registry", hKey)
        ret = GetValueByIndex(hKey, Index, Name, bArr, vType)
        While ret
            If Len(Name) = 0 Then Name = "(预 设 值)"
            List1.AddItem Name & vbTab & ValueOutput(bArr, vType)
            Index = Index + 1
            ret = GetValueByIndex(hKey, Index, Name, bArr, vType)
        Wend
        Call RegCloseKey(hKey)
    End SubPrivate Sub Form_Unload(Cancel As Integer)
        Dim Index As Long, ret As Long, hKey As Long
        Dim bArr() As Byte, Name As String, vType As Long    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\kj\Registry", hKey)
        ret = GetValueByIndex(hKey, Index, Name, bArr, vType)
        While ret
            Call RegDeleteValue(hKey, Name)
            ' 不可以执行 Index = Index + 1，因为 Index = 0 的 Value 已删除，
            ' 後面的 Index 向前递减，所以 Index = 0 又可以读到 Value，
            ' 其实在这一个 While 回圈中，您可以将 Index 变数改成 0
            ret = GetValueByIndex(hKey, Index, Name, bArr, vType)
        Wend
        Call RegCloseKey(hKey)
        MsgBox "kj\Registry 的 Value 已删除，利用 RegEdit 检查时，记得要先执行功能的「检视／重新整理」！"
    End SubFunction ValueOutput(bArr() As Byte, ByVal vType As Long) As String
        Dim S As String, S2 As String, length As Integer, L As Long
        Dim i As Integer, sArr() As String    Select Case vType
            Case REG_SZ, REG_EXPAND_SZ
                ByteArrayToString bArr, S            ' 呼叫 ExpandEnvironmentStrings
                S2 = String(Len(S) + 256, Chr(0))
                length = ExpandEnvironmentStrings(S, S2, Len(S2))
                S = Left(S2, length - 1)
                ValueOutput = "Type=String, Data=" & S        Case REG_MULTI_SZ
                ByteArrayToMultiString bArr, sArr
                ValueOutput = "Type=MultiString, Data="
                For i = LBound(sArr) To UBound(sArr)
                    ValueOutput = ValueOutput & sArr(i) & ", "
                Next i        Case REG_DWORD, REG_DWORD_BIG_ENDIAN
                ByteArrayToLong bArr, L
                ValueOutput = "Type=Long, Data=" & L        Case REG_BINARY
                ValueOutput = "Type=Byte Array, Data="
                For i = LBound(bArr) To UBound(bArr)
                    ValueOutput = ValueOutput + Format(Hex(bArr(i)), "00")
                Next i
        End Select
    End FunctionPrivate Sub Command2_Click()
        Unload Me
        End
    End Sub
    Private Sub Command3_Click()
    Dim hKey As Long, resu As Long
    Dim aa As Boolean
    Dim bytary() As Byte
    Dim str5 As String
    resu = RegOpenKey(HKEY_LOCAL_MACHINE, _
        "SOFTWARE\Microsoft\Windows\CurrentVersion", hKey)
    aa = GetValue(hKey, "ProductId", bytary, REG_SZ)
    Call ByteArrayToString(bytary, str5)
    Debug.Print str5
    Call RegCloseKey(hKey)
    End Sub  
     
       
    　
      
     
      

  3.   

    '写 RegSetValueEx("HKEY_LOCAL_MACHINE", "Software\Mircrosoft \Windows\CurrentVersion\Setup","SetupOnce",0,4,Updata,4)'读
    Const REG_SZ = 1 ' Unicode nul terminated string
    Const REG_BINARY = 3 ' Free form binary
    Public Const HKEY_LOCAL_MACHINE = &H80000002
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, 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 Longprivate sub command1_click()s
        'Get reg Path value
        Ret = GetString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Office\10.0\Excel\InstallRoot", "Path")
        If Ret = "" Then 
    MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title
    Exit sub
        else
    text1.text=Ret
        end if
    end subPublic Function GetString(hKey As Long, strPath As String, strValue As String) As String
        Dim Ret
        RegOpenKey hKey, strPath, Ret
        GetString = RegQueryStringValue(Ret, strValue)
        RegCloseKey Ret
    End FunctionFunction RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
        Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
        'retrieve information about the key
        lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
        If lResult = 0 Then
            If lValueType = REG_SZ Then
                'Create a buffer
                strBuf = String(lDataBufSize, Chr$(0))
                'retrieve the key's content
                lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
                If lResult = 0 Then
                    'Remove the unnecessary chr$(0)'s
                    RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
                End If
            ElseIf lValueType = REG_BINARY Then
                Dim strData As Integer
                'retrieve the key's value
                lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
                If lResult = 0 Then
                    RegQueryStringValue = strData
                End If
            End If
        End If
    End Function
      

  4.   

    读为详细的代码。
    写，自己看看RegSetValueEx的用法。