注册表的问题，请大家帮忙！

这里有一个封装的注册表的类模块，看看：'regclass.clsOption Explicit'Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 '  dderror
Private Const ERROR_NO_MORE_ITEMS = 259
'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End TypePrivate Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type'Registry Function Prototypes
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  ByVal samDesired As Long, phkResult As Long) As LongPrivate Declare Function RegSetValueExStr Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As LongPrivate Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32" 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 LongPrivate 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 LongPrivate Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
    ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    ByVal cbName As Long) As LongPrivate 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, ByVal lpType As Long, _
   ByVal lpData As Long, ByVal lpcbData As Long) As Long

Private Declare Function RegEnumValueLong 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 Long, lpcbData As Long) As Long
Private Declare Function RegEnumValueStr 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, _
   ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValueByte 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 LongPrivate 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 Any) As LongPrivate Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  (ByVal hKey As Long, ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  (ByVal hKey As Long, ByVal lpValueName As String) As Long' Other declares:
'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public Enum ERegistryClassConstants
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End EnumPublic Enum ERegistryValueTypes
'Predefined Value Types
    REG_NONE = (0)                         'No value type
    REG_SZ = (1)                           'Unicode nul terminated string
    REG_EXPAND_SZ = (2)                    'Unicode nul terminated string w/enviornment var
    REG_BINARY = (3)                       'Free form binary
    REG_DWORD = (4)                        '32-bit number
    REG_DWORD_LITTLE_ENDIAN = (4)          '32-bit number (same as REG_DWORD)
    REG_DWORD_BIG_ENDIAN = (5)             '32-bit number
    REG_LINK = (6)                         'Symbolic Link (unicode)
    REG_MULTI_SZ = (7)                     'Multiple Unicode strings
    REG_RESOURCE_LIST = (8)                'Resource list in the resource map
    REG_FULL_RESOURCE_DESCRIPTOR = (9)     'Resource list in the hardware description
    REG_RESOURCE_REQUIREMENTS_LIST = (10)
End Enum
Private Sub GetRootSubKey(Key As String, Root As String, ClassKey As ERegistryClassConstants, SubKey As String, ValueKey As String)

    Dim vt As Variant
    vt = Split(Key, "\")

    Dim l As Long
    l = UBound(vt)
    If l > 0 Then
        Root = UCase$(vt(0))
        Select Case Root
        Case "HKEY_CURRENT_USER"
            ClassKey = HKEY_CURRENT_USER
        Case "HKEY_LOCAL_MACHINE"
            ClassKey = HKEY_LOCAL_MACHINE
        Case "HKEY_USERS"
            ClassKey = HKEY_USERS
        Case "HKEY_CLASSES_ROOT"
            ClassKey = HKEY_CLASSES_ROOT
        'Case "HKEY_PERFORMANCE_DATA"
        'Case "HKEY_DYN_DATA"
        'Case "HKEY_CURRENT_CONFIG"
        Case Else
            GoTo InvalidArg
        End Select

        ValueKey = vt(l)

        For l = l - 1 To 1 Step -1
            Dim b As Boolean
            If b Then
                SubKey = vt(l) & "\" & SubKey
            Else
                b = True
                SubKey = vt(l)
            End If
        Next

    Else
InvalidArg:
        Err.Raise 5 + 512, , "无效的键名路径"
    End If
End SubPublic Sub DeleteRegSetting(Key As String)

    Dim Root As String
    Dim SubKey As String
    Dim ValueKey As String
    Dim ClassKey As ERegistryClassConstants

    GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

    Dim hKey As Long
    If Len(ValueKey) > 0 Then
        Dim e As Long
        e = RegOpenKeyEx(ClassKey, SubKey, 0, KEY_QUERY_VALUE, hKey)
        If e Then
            GoTo ErrorHandle
        End If

        e = RegDeleteValue(hKey, ValueKey)
        RegCloseKey hKey

        If e Then
            GoTo ErrorHandle
        End If
    Else
        e = RegDeleteKey(ClassKey, SubKey)
        If e Then
ErrorHandle:
            Err.Raise 5 + 512, , GetSystemError(e) '"无效的键名路径"
        End If
    End If
End Sub
Public Function GetRegSetting(Key As String, Optional Default As Variant) As Variant    Dim vValue As Variant
    Dim cData As Long, sData As String, ordType As Long, e As Long
    Dim hKey As Long    Dim Root As String
    Dim SubKey As String
    Dim ValueKey As String
    Dim ClassKey As ERegistryClassConstants

    GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

    e = RegOpenKeyEx(ClassKey, SubKey, 0, KEY_QUERY_VALUE, hKey)

    If e = 0 Then
        e = RegQueryValueExLong(hKey, ValueKey, 0&, ordType, 0&, cData)
        If e = 0 Or e = ERROR_MORE_DATA Then

            Select Case ordType
            Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
                Dim iData As Long
                e = RegQueryValueExLong(hKey, ValueKey, 0&, _
                                       ordType, iData, cData)
                vValue = CLng(iData)

            Case REG_DWORD_BIG_ENDIAN  ' Unlikely, but you never know
                Dim dwData As Long
                e = RegQueryValueExLong(hKey, ValueKey, 0&, _
                                       ordType, dwData, cData)
                vValue = SwapEndian(dwData)

            Case REG_SZ, REG_MULTI_SZ ' Same thing to Visual Basic
                sData = String$(cData - 1, 0)
                e = RegQueryValueExStr(hKey, ValueKey, 0&, _
                                       ordType, sData, cData)
                vValue = sData

            Case REG_EXPAND_SZ
                sData = String$(cData - 1, 0)
                e = RegQueryValueExStr(hKey, ValueKey, 0&, _
                                       ordType, sData, cData)
                vValue = ExpandEnvStr(sData)

            ' Catch REG_BINARY and anything else
            Case Else
                Dim abData() As Byte
                ReDim abData(cData - 1)
                e = RegQueryValueExByte(hKey, ValueKey, 0&, _
                                        ordType, abData(0), cData)
                vValue = abData

            End Select
        End If

        RegCloseKey hKey

    End If

    If e Then
        If IsMissing(Default) Then
            Err.Raise 5 + 512, , GetSystemError(e) ' "无效的键名路径"
        Else
            vValue = Default
        End If
    End If

    GetRegSetting = vValue
End Function
Private Function SwapEndian(ByVal dw As Long) As Long
'    CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
'    CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
'    CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
'    CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
    Dim l0 As Long
    Dim l1 As Long
    Dim l2 As Long
    Dim l3 As Long

    Dim bt(3) As Byte
    Dim l As Long
    For l = 0 To 3
        bt(l) = dw Mod &H100
        dw = dw \ &H100
    Next

    dw = bt(3)
    For l = 2 To 0 Step -1
        dw = dw * &H100 + bt(l)
    Next

    SwapEndian = dw

End FunctionPrivate Function ExpandEnvStr(sData As String) As String
    Dim c As Long, s As String
    ' Get the length
    s = "" ' Needed to get around Windows 95 limitation
    c = ExpandEnvironmentStrings(sData, s, c)
    ' Expand the string
    s = String$(c - 1, 0)
    c = ExpandEnvironmentStrings(sData, s, c)
    ExpandEnvStr = s
End Function
Public Sub SaveRegSetting(Key As String, ByVal vValue As Variant)
    Dim ordType As Long
    Dim c As Long
    Dim hKey As Long
    Dim e As Long
    Dim lCreate As Long
    Dim tSA As SECURITY_ATTRIBUTES    'Open or Create the key
    Dim Root As String
    Dim SubKey As String
    Dim ValueKey As String
    Dim ClassKey As ERegistryClassConstants

    GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

    e = RegCreateKeyEx(ClassKey, SubKey, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
    If e Then
        Err.Raise 5 + 512, , GetSystemError(e) ' "无效的键名路径"
    Else        Select Case VarType(vValue)
        Case vbArray + vbByte
            Dim ab() As Byte
            ab = vValue
            ordType = REG_BINARY
            c = UBound(ab) - LBound(ab) + 1
            e = RegSetValueExByte(hKey, ValueKey, 0&, ordType, ab(0), c)
        Case vbInteger, vbLong
            Dim i As Long
            i = vValue
            ordType = REG_DWORD
            e = RegSetValueExLong(hKey, ValueKey, 0&, ordType, i, 4)
        Case Else
            Dim s As String, iPos As Long
            s = vValue
            ordType = REG_SZ
            ' Assume anything with two non-adjacent percents is expanded string
            iPos = InStr(s, "%")
            If iPos Then
                If InStr(iPos + 2, s, "%") Then
                    ordType = REG_EXPAND_SZ
                End If
            End If
            c = Len(s) + 1
            e = RegSetValueExStr(hKey, ValueKey, 0&, ordType, s, c)
        End Select

        'Close the key
        RegCloseKey hKey

        If e Then
            Err.Raise 5 + 512, , GetSystemError(e)  '"不能储存"
        End If

    End If

End Sub
Public Function GetAllRegKeys(Key As String) As Variant
    Dim Root As String
    Dim SubKey As String
    Dim ValueKey As String
    Dim ClassKey As ERegistryClassConstants

    GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

    Dim lResult As Long
    Dim hKey As Long
    Dim sName As String
    Dim lNameSize As Long
    Dim sData As String
    Dim lIndex As Long
    Dim cJunk As Long
    Dim cNameMax As Long
    Dim ft As Currency

   ' Log "EnterEnumerateValues"    Dim iKeyCount As Integer
    Dim sKeyNames() As String

    iKeyCount = 0
    Erase sKeyNames()    On Error GoTo ErrorHandle

   lIndex = 0
   lResult = RegOpenKeyEx(ClassKey, SubKey, 0, KEY_QUERY_VALUE, hKey)

   If (lResult = ERROR_SUCCESS) Then
      ' Log "OpenedKey:" & m_hClassKey & "," & m_sSectionKey
      lResult = RegQueryInfoKey(hKey, vbNullString, cJunk, 0, _
                               cJunk, cJunk, cJunk, cJunk, _
                               cNameMax, cJunk, cJunk, ft)
       Do While lResult = ERROR_SUCCESS

           'Set buffer space
           lNameSize = cNameMax + 1
           sName = String$(lNameSize, 0)
           If (lNameSize = 0) Then lNameSize = 1

           ' Log "Requesting Next Value"

           'Get value name:
           lResult = RegEnumValue(hKey, lIndex, sName, lNameSize, _
                                  0&, 0&, 0&, 0&)
           ' Log "RegEnumValue returned:" & lResult
           If (lResult = ERROR_SUCCESS) Then

                ' Although in theory you can also retrieve the actual
                ' value and type here, I found it always (ultimately) resulted in
                ' a GPF, on Win95 and NT.  Why?  Can anyone help?

               sName = StrConv(LeftB$(StrConv(sName, vbFromUnicode), lNameSize), vbUnicode)
               ' Log "Enumerated value:" & sName

               ReDim Preserve sKeyNames(iKeyCount) As String
               sKeyNames(iKeyCount) = sName
               iKeyCount = iKeyCount + 1
           End If
           lIndex = lIndex + 1
       Loop

       GetAllRegKeys = sKeyNames
    Else
        Err.Raise 5 + 512, , GetSystemError(lResult) ' "无效的键名路径"
    End If
    Exit Function

ErrorHandle:
    RegCloseKey hKey

    ReErr
End Function

shines:
谢谢你了！不过我说过我是菜鸟你给我这么长一段代码我都看不明白
能不能你就给我一段把上面的数字写到"xinjun"里去的代码呢？
真是拜托了

好吧，我来帮你解决，请你把分数给我！Option ExplicitPrivate Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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 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 LongPrivate Const REG_SZ = 1            ' Unicode nul terminated string
Private Const REG_BINARY = 3        ' Free form binary
Private Const REG_DWORD = 4         ' 32-bit numberPrivate Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003Private Sub Form_Load()
    Dim YourString As String
    '你要写入的字符串
    YourString = "dd de df ab c3 9c 9c 9c" + _
                 "da ff df ab c3 9c 9c 9c" + _
                 "ee de df ab c3 9c 9c 9c" + _
                 "aa de df ab c3 9c 9c 99"
    Dim i As Long
    Dim Length As Long
    Dim strByte() As Byte
    Length = Int((Len(YourString) - 1) / 3)
    ReDim strByte(Length)
    For i = 0 To Length
        strByte(i) = CByte(Val("&H" + Mid(YourString, i * 3 + 1, 2)))
    Next i
    '写入字符串
    SaveString HKEY_CURRENT_USER, "RemoteAccess\Addresses", "xinjun", strByte
End SubPublic Sub SaveString(hKey As Long, strPath As String, strValue As String, strData() As Byte)
    Dim KeyHand As Long
    Dim r As Long
    r = RegCreateKey(hKey, strPath, KeyHand)
    r = RegOpenKey(hKey, strPath, KeyHand)
    r = RegSetValueEx(KeyHand, strValue, 0, REG_BINARY, strData(0), UBound(strData) - LBound(strData) + 1)
    r = RegCloseKey(KeyHand)
End Sub

shines:
很感谢你！希望以后还有机会跟你学习！
我这个问题大概花了四五百分，如果你有兴趣的话可以找找，比如说输入“二进制值”；或者“tcp/ip协议“，找到lengxue发的贴子，我都给你。

调试易

注册表的问题，请大家帮忙！

解决方案 »