Option Explicit
' =========================================================
' Class: cRegistry
' Author: Fatant Studio.
' Progenitor: Steve McMahon (21 Feb 1997) [http://vbaccelerator.com]
' Date : 12 Feb 2001
' ---------------------------------------------------------'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 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 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 EnumPrivate Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Private Const SUBLANG_DEFAULT = &H1
Private Const ERROR_BAD_USERNAME = 2202&
Private Declare Function GetLastError Lib "Kernel32" () As Long
Private Declare Function FormatMessage Lib "Kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private m_hClassKey As Long
Private m_sSectionKey As String
Private m_sValueKey As String
Private m_vValue As Variant
Private m_sSetValue As String
Private m_vDefault As Variant
Private m_eValueType As ERegistryValueTypes
Private sError As StringPublic Property Get KeyExists() As Boolean Dim hKey As Long
If RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, 1, hKey) = ERROR_SUCCESS Then
KeyExists = True
RegCloseKey hKey
Else
KeyExists = False
End If
End PropertyPublic Function CreateKey() As Long Dim tSA As SECURITY_ATTRIBUTES
Dim hKey As Long
Dim lCreate As Long
'Open or Create the key
CreateKey = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, tSA, hKey, lCreate)
If CreateKey Then
sError = GetErrorDescription(CreateKey)
Else
'Close the key
RegCloseKey hKey
End If
End FunctionPublic Function DeleteKey() As Long DeleteKey = RegDeleteKey(m_hClassKey, m_sSectionKey)
If DeleteKey Then
sError = GetErrorDescription(DeleteKey)
End If
End FunctionPublic Function DeleteValue() As Long Dim e As Long
Dim hKey As Long DeleteValue = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ALL_ACCESS, hKey)
If DeleteValue Then
sError = GetErrorDescription(DeleteValue)
Else
DeleteValue = RegDeleteValue(hKey, m_sValueKey)
If DeleteValue Then
sError = GetErrorDescription(DeleteValue)
End If
End IfEnd FunctionPublic Property Get Value() As Variant Dim vValue As Variant
Dim cData As Long, sData As String, ordType As Long, e As Long
Dim hKey As Long e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, 0&, cData)
If e And e <> ERROR_MORE_DATA Then
Value = m_vDefault
Exit Property
End If
m_eValueType = ordType
Select Case ordType
Case REG_DWORD ', REG_DWORD_LITTLE_ENDIAN
Dim iData As Long
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, iData, cData)
vValue = CLng(iData)
' Case REG_DWORD_BIG_ENDIAN ' Unlikely, but you never know
' Dim dwData As Long
' e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, dwData, cData)
' vValue = SwapEndian(dwData)
Case REG_SZ, REG_MULTI_SZ ' Same thing to Visual Basic
If cData <= 0 Then
vValue = ""
Else
sData = String$(cData - 1, 0)
e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
vValue = StripTerminator(sData)
End If
' Case REG_EXPAND_SZ
' If cData <= 0 Then
' vValue = ""
' Else
' sData = String$(cData - 1, 0)
' e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
' vValue = ExpandEnvStr(sData)
' End If
Case Else ' Catch REG_BINARY and anything else
Dim abData() As Byte
ReDim abData(cData)
e = RegQueryValueExByte(hKey, m_sValueKey, 0&, ordType, abData(0), cData)
vValue = abData
End Select
Value = vValue
End PropertyPublic Property Let Value(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
e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
If e Then
sError = GetErrorDescription(e)
Else Select Case m_eValueType
Case REG_BINARY
If (VarType(vValue) = vbArray + vbByte) Then
Dim ab() As Byte
ab = vValue
ordType = REG_BINARY
c = UBound(ab) - LBound(ab) - 1
e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), c)
Else
sError = GetErrorDescription(26001)
End If
Case REG_DWORD ', REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
Dim i As Long
i = CLng(vValue)
ordType = REG_DWORD
e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, i, 4)
End If
Case REG_SZ, REG_EXPAND_SZ
Dim s As String, iPos As Long
s = vValue
If s = "" Then s = " "
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
c = LenB(s) + 1
e = RegSetValueExStr(hKey, m_sValueKey, 0&, ordType, s, c)
' User should convert to a compatible type before calling
Case Else
e = ERROR_INVALID_DATA
End Select
If Not e Then
m_vValue = vValue
Else
sError = GetErrorDescription(vbObjectError + 1048 + 26001)
End If
'Close the key
RegCloseKey hKey
End If
End PropertyPublic Function EnumerateValues(ByRef sKeyNames() As String, ByRef iKeyCount As Long) As Long
Dim lResult As Long
Dim hKey As Long
Dim sName As String
Dim lIndex As Long
iKeyCount = 0
Erase sKeyNames()
lIndex = 0
lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
If (lResult = ERROR_SUCCESS) Then
Do
'Set buffer space
sName = String$(255, 0)
'Get value name:
lResult = RegEnumValue(hKey, lIndex, sName, 255, 0&, 0&, 0&, 0&)
If (lResult = ERROR_SUCCESS) Then
sName = StripTerminator(sName)
iKeyCount = iKeyCount + 1
ReDim Preserve sKeyNames(1 To iKeyCount) As String
sKeyNames(iKeyCount) = sName
Else
Exit Do
End If
lIndex = lIndex + 1
Loop
EnumerateValues = 0
RegCloseKey hKey
Else
EnumerateValues = lResult
sError = GetErrorDescription(EnumerateValues)
End If
End FunctionPublic Function EnumerateSections(ByRef sSect() As String, ByRef iSectCount As Long) As Long
Dim lResult As Long
Dim hKey As Long
Dim szBuffer As String
Dim lIndex As Long iSectCount = 0
Erase sSect
lIndex = 0 lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
If lResult = ERROR_SUCCESS Then
Do While lResult = ERROR_SUCCESS
'Set buffer space
szBuffer = String$(255, 0)
'Get next value
lResult = RegEnumKey(hKey, lIndex, szBuffer, 255)
If (lResult = ERROR_SUCCESS) Then
iSectCount = iSectCount + 1
ReDim Preserve sSect(1 To iSectCount)
sSect(iSectCount) = StripTerminator(szBuffer)
End If
lIndex = lIndex + 1
Loop
RegCloseKey hKey
EnumerateSections = 0
Else
EnumerateSections = lResult
sError = GetErrorDescription(EnumerateSections)
End If
End FunctionPublic Property Get RegError() As String
RegError = sError
End PropertyPublic Property Get ValueType() As ERegistryValueTypes
ValueType = m_eValueType
End Property
Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
m_eValueType = eValueType
End Property
Public Property Get ClassKey() As ERegistryClassConstants
ClassKey = m_hClassKey
End Property
Public Property Let ClassKey(ByVal eKey As ERegistryClassConstants)
m_hClassKey = eKey
End Property
Public Property Get SectionKey() As String
SectionKey = m_sSectionKey
End Property
Public Property Let SectionKey(ByVal sSectionKey As String)
m_sSectionKey = sSectionKey
End Property
Public Property Get ValueKey() As String
ValueKey = m_sValueKey
End Property
Public Property Let ValueKey(ByVal sValueKey As String)
m_sValueKey = sValueKey
End Property
Public Property Get Default() As Variant
Default = m_vDefault
End Property
Public Property Let Default(ByVal vDefault As Variant)
m_vDefault = vDefault
End PropertyPrivate 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
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 FunctionPrivate Function StripTerminator(sInput As String) As String
Dim ZeroPos As Integer
'Search the first chr$(0)
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End FunctionPrivate Function GetErrorDescription(lErr As Long) As String Dim Buffer As String
Dim l As Long
'Create a string buffer
Buffer = Space(255)
'Format the message string
l = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErr, LANG_NEUTRAL, Buffer, 255, ByVal 0&)
If l = 0 Then
GetErrorDescription = GetErrorDescription(GetLastError)
Else
GetErrorDescription = StripTerminator(Buffer)
End If
End Function 把上面的代码存为cRegistry.cls,使用是示例如下:
Dim cReg As New cRegistry
cReg.ClassKey = HKEY_CURRENT_USER
cReg.ValueType = REG_SZ
cReg.SectionKey = "Software\AAA"
If cReg.KeyExists Then
cReg.SectionKey = "Software\AAA\系统配置信息"
cReg.ValueKey = "缓存路径"
astr = cReg.Value
end if
' =========================================================
' Class: cRegistry
' Author: Fatant Studio.
' Progenitor: Steve McMahon (21 Feb 1997) [http://vbaccelerator.com]
' Date : 12 Feb 2001
' ---------------------------------------------------------'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 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 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 EnumPrivate Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Private Const SUBLANG_DEFAULT = &H1
Private Const ERROR_BAD_USERNAME = 2202&
Private Declare Function GetLastError Lib "Kernel32" () As Long
Private Declare Function FormatMessage Lib "Kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private m_hClassKey As Long
Private m_sSectionKey As String
Private m_sValueKey As String
Private m_vValue As Variant
Private m_sSetValue As String
Private m_vDefault As Variant
Private m_eValueType As ERegistryValueTypes
Private sError As StringPublic Property Get KeyExists() As Boolean Dim hKey As Long
If RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, 1, hKey) = ERROR_SUCCESS Then
KeyExists = True
RegCloseKey hKey
Else
KeyExists = False
End If
End PropertyPublic Function CreateKey() As Long Dim tSA As SECURITY_ATTRIBUTES
Dim hKey As Long
Dim lCreate As Long
'Open or Create the key
CreateKey = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, tSA, hKey, lCreate)
If CreateKey Then
sError = GetErrorDescription(CreateKey)
Else
'Close the key
RegCloseKey hKey
End If
End FunctionPublic Function DeleteKey() As Long DeleteKey = RegDeleteKey(m_hClassKey, m_sSectionKey)
If DeleteKey Then
sError = GetErrorDescription(DeleteKey)
End If
End FunctionPublic Function DeleteValue() As Long Dim e As Long
Dim hKey As Long DeleteValue = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ALL_ACCESS, hKey)
If DeleteValue Then
sError = GetErrorDescription(DeleteValue)
Else
DeleteValue = RegDeleteValue(hKey, m_sValueKey)
If DeleteValue Then
sError = GetErrorDescription(DeleteValue)
End If
End IfEnd FunctionPublic Property Get Value() As Variant Dim vValue As Variant
Dim cData As Long, sData As String, ordType As Long, e As Long
Dim hKey As Long e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, 0&, cData)
If e And e <> ERROR_MORE_DATA Then
Value = m_vDefault
Exit Property
End If
m_eValueType = ordType
Select Case ordType
Case REG_DWORD ', REG_DWORD_LITTLE_ENDIAN
Dim iData As Long
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, iData, cData)
vValue = CLng(iData)
' Case REG_DWORD_BIG_ENDIAN ' Unlikely, but you never know
' Dim dwData As Long
' e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, dwData, cData)
' vValue = SwapEndian(dwData)
Case REG_SZ, REG_MULTI_SZ ' Same thing to Visual Basic
If cData <= 0 Then
vValue = ""
Else
sData = String$(cData - 1, 0)
e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
vValue = StripTerminator(sData)
End If
' Case REG_EXPAND_SZ
' If cData <= 0 Then
' vValue = ""
' Else
' sData = String$(cData - 1, 0)
' e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
' vValue = ExpandEnvStr(sData)
' End If
Case Else ' Catch REG_BINARY and anything else
Dim abData() As Byte
ReDim abData(cData)
e = RegQueryValueExByte(hKey, m_sValueKey, 0&, ordType, abData(0), cData)
vValue = abData
End Select
Value = vValue
End PropertyPublic Property Let Value(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
e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
If e Then
sError = GetErrorDescription(e)
Else Select Case m_eValueType
Case REG_BINARY
If (VarType(vValue) = vbArray + vbByte) Then
Dim ab() As Byte
ab = vValue
ordType = REG_BINARY
c = UBound(ab) - LBound(ab) - 1
e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), c)
Else
sError = GetErrorDescription(26001)
End If
Case REG_DWORD ', REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
Dim i As Long
i = CLng(vValue)
ordType = REG_DWORD
e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, i, 4)
End If
Case REG_SZ, REG_EXPAND_SZ
Dim s As String, iPos As Long
s = vValue
If s = "" Then s = " "
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
c = LenB(s) + 1
e = RegSetValueExStr(hKey, m_sValueKey, 0&, ordType, s, c)
' User should convert to a compatible type before calling
Case Else
e = ERROR_INVALID_DATA
End Select
If Not e Then
m_vValue = vValue
Else
sError = GetErrorDescription(vbObjectError + 1048 + 26001)
End If
'Close the key
RegCloseKey hKey
End If
End PropertyPublic Function EnumerateValues(ByRef sKeyNames() As String, ByRef iKeyCount As Long) As Long
Dim lResult As Long
Dim hKey As Long
Dim sName As String
Dim lIndex As Long
iKeyCount = 0
Erase sKeyNames()
lIndex = 0
lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
If (lResult = ERROR_SUCCESS) Then
Do
'Set buffer space
sName = String$(255, 0)
'Get value name:
lResult = RegEnumValue(hKey, lIndex, sName, 255, 0&, 0&, 0&, 0&)
If (lResult = ERROR_SUCCESS) Then
sName = StripTerminator(sName)
iKeyCount = iKeyCount + 1
ReDim Preserve sKeyNames(1 To iKeyCount) As String
sKeyNames(iKeyCount) = sName
Else
Exit Do
End If
lIndex = lIndex + 1
Loop
EnumerateValues = 0
RegCloseKey hKey
Else
EnumerateValues = lResult
sError = GetErrorDescription(EnumerateValues)
End If
End FunctionPublic Function EnumerateSections(ByRef sSect() As String, ByRef iSectCount As Long) As Long
Dim lResult As Long
Dim hKey As Long
Dim szBuffer As String
Dim lIndex As Long iSectCount = 0
Erase sSect
lIndex = 0 lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
If lResult = ERROR_SUCCESS Then
Do While lResult = ERROR_SUCCESS
'Set buffer space
szBuffer = String$(255, 0)
'Get next value
lResult = RegEnumKey(hKey, lIndex, szBuffer, 255)
If (lResult = ERROR_SUCCESS) Then
iSectCount = iSectCount + 1
ReDim Preserve sSect(1 To iSectCount)
sSect(iSectCount) = StripTerminator(szBuffer)
End If
lIndex = lIndex + 1
Loop
RegCloseKey hKey
EnumerateSections = 0
Else
EnumerateSections = lResult
sError = GetErrorDescription(EnumerateSections)
End If
End FunctionPublic Property Get RegError() As String
RegError = sError
End PropertyPublic Property Get ValueType() As ERegistryValueTypes
ValueType = m_eValueType
End Property
Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
m_eValueType = eValueType
End Property
Public Property Get ClassKey() As ERegistryClassConstants
ClassKey = m_hClassKey
End Property
Public Property Let ClassKey(ByVal eKey As ERegistryClassConstants)
m_hClassKey = eKey
End Property
Public Property Get SectionKey() As String
SectionKey = m_sSectionKey
End Property
Public Property Let SectionKey(ByVal sSectionKey As String)
m_sSectionKey = sSectionKey
End Property
Public Property Get ValueKey() As String
ValueKey = m_sValueKey
End Property
Public Property Let ValueKey(ByVal sValueKey As String)
m_sValueKey = sValueKey
End Property
Public Property Get Default() As Variant
Default = m_vDefault
End Property
Public Property Let Default(ByVal vDefault As Variant)
m_vDefault = vDefault
End PropertyPrivate 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
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 FunctionPrivate Function StripTerminator(sInput As String) As String
Dim ZeroPos As Integer
'Search the first chr$(0)
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End FunctionPrivate Function GetErrorDescription(lErr As Long) As String Dim Buffer As String
Dim l As Long
'Create a string buffer
Buffer = Space(255)
'Format the message string
l = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErr, LANG_NEUTRAL, Buffer, 255, ByVal 0&)
If l = 0 Then
GetErrorDescription = GetErrorDescription(GetLastError)
Else
GetErrorDescription = StripTerminator(Buffer)
End If
End Function 把上面的代码存为cRegistry.cls,使用是示例如下:
Dim cReg As New cRegistry
cReg.ClassKey = HKEY_CURRENT_USER
cReg.ValueType = REG_SZ
cReg.SectionKey = "Software\AAA"
If cReg.KeyExists Then
cReg.SectionKey = "Software\AAA\系统配置信息"
cReg.ValueKey = "缓存路径"
astr = cReg.Value
end if
解决方案 »
- 现在VB做桌面程序都用什么版本开发
- VB 程序中通过SQL语句取数,提示“超时已过期”
- VB winsock 从没见过的问题 ,高手请看....
- 超简单问题。
- 请vb有绿色版吗?
- 请高手指点:如果让程序适应不同的分辩率?真诚期待!!!
- vb,picturebox中,如何在图片的指定位置打印文字呢?
- 请问who知道,如何将一个程序如何加入win2000的“服务”里。谢谢
- 用PictureBox画图的位置和用Printer对象画图的位置出现偏差:Printer出来的出现向右和向下移!Why???
- 如何单机开发服务器/客户机程序
- 初学者关于MsFlexGrid的问题
- 写数据库用VB6好还是用PB7好?
cReg.ClassKey = HKEY_CURRENT_USER 设定基键
cReg.ValueType = REG_SZ 设定键值类型
cReg.SectionKey = "Software\AAA" 设定要读的键名
If cReg.KeyExists Then 判断键是否存在
cReg.SectionKey = "Software\AAA\系统配置信息" 设定要读的键名
cReg.ValueKey = "缓存路径" 设定要读取的项名
astr = cReg.Value 取值
end if 至于类里就不用管拉。
用法:
CreateKey "HKEY_CURRENT_USER\Software\School\Test\Settings"
SetStringValue "HKEY_CURRENT_USER\Software\School\Test\Settings", "LastUser", "I"
GetLastUser = GetStringValue("HKEY_CURRENT_USER\Software\School\Test\Settings", "LastUser")
能否把你的操作注册表的DLL(含源码)给我一份呢?
我的信箱:[email protected]
再给你一个好东东:http://www.sqreg.com/file/vb/reg_01.htm
请在project中加入"registry access control"的组件,
再按"F2", 从列表中选择"regtool5",即可看到MS提供的function.
1、如果我不想删子键,只想删该子键下的键值名与键值数据呢?
2、怎样判断某个子键是否存在?to uguess: 我按您写的做了个cRegistry.cls后,
把代码段"Dim cReg As New cRegistry
cReg.ClassKey = HKEY_CURRENT_USER
cReg.ValueType = REG_SZ
cReg.SectionKey = "Software\AAA" "放入窗体的通用说明中,(AAA用某子键代替)
再在按钮的CLICK中输入" If cReg.KeyExists Then
cReg.SectionKey = "Software\AAA\系统配置信息"
cReg.ValueKey = "缓存路径"
astr = cReg.Value
end if " "后,运行时,系统提示"要求对象",黄色光带指向If cReg.KeyExists Then这一句。不知是为何?而且说实话,我并不知道上面的IF ....END IF 段是在做什么?它能实现我需要的"创建、获取、删除、是否存在某个键或键值"功能吗? 另外很感谢您给的那个网址。to 阿木:我给您发了几次邮件,不知何故,都被系统退了回来,故在此写上我的邮箱:[email protected].
如果您能发DLL过来的话,请就使用方法略加说明几句好吗?to shiyang: 我不知道您的"请在project中加入"registry access control"的组件"是指在哪儿加入?我在工程-部件与引用中 都没找到registry access control这一项。感谢各位高手的帮助,请继续指点!
是这样的,如果你需要定义全局或是局部的变量,就把 Dim cReg As New cRegistry
放在通用声明段,其余的
cReg.ClassKey = HKEY_CURRENT_USER
cReg.ValueType = REG_SZ
cReg.SectionKey = "Software\AAA"
是放在具体的代码里的。
这个 cReg.KeyExists 就是判断某个键是否存在的;
创建一个键只须 先将键名赋值,然后用 cReg.CreateKey 即可,如:
cReg.SectionKey = "Software\AAA"
cReg.CreateKey
这样就创建了一个键AAA。
同样,删除一个键只须 先将键名赋值,然后用 cReg.DeleteKey 即可,如:
cReg.SectionKey = "Software\AAA"
cReg.DeleteKey
这样就删除了一个键AAA。 其它的使用方法都类似。不过如果你对VB的类的使用没有经验的话,最好找一本基础的书看看相关的内容。 说实在的,这是目前我见过的最好的处理注册表相关操作的代码,功能非常强大,你需要慢慢领会。
老 U 啊,跑哪儿去啦,我再等你回话呐! 老 U 啊,跑哪儿去啦,我再等你回话呐!老 U 啊,跑哪儿去啦,我再等你回话呐! 老 U 啊,跑哪儿去啦,我再等你回话呐! 老 U 啊,跑哪儿去啦,我再等你回话呐! 老 U 啊,跑哪儿去啦,我再等你回话呐!
to 阿木:感谢您寄来的DLL,您的程序写得很严谨,注释也很详细,
然而不好意思的是我确实从没在程序中直接调用过DLL,因此老是出错,现以在HKEY_CLASSES_ROOT\.art下创建一个test子键为例,把我的做法写在下面,
请您指出错在哪些地方,好吗?1、新建一个窗体,在其上放一个按钮。
2、在"工程--引用"中把AMN Regitry 1.00前面的方框选中,
3、在"通用--声明"中定义两个变量:Dim newreg As New Registry
Dim a As Long
4、在按钮的CLICK中加入一句代码:
a = newreg.REG_CreateKey(HKEY_CLASSES_ROOT\.art, test, REG_OPTION_RESERVED, KEY_ALL_ACCESS)
可运行时,系统提示:"无效的引用"或"byref参数类型不符"等,我便加了几个引号,变成:
a =newreg.REG_CreateKey"HKEY_CLASSES_ROOT\.art", "test",REG_OPTION_RESERVED, KEY_ALL_ACCESS)
运行时,系统又提示:"类型不匹配"
请就创建、删除子键举一至两例。得到解答后,我将尽快结帐,以谢各位!
'操作注册彪函数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 ERROR_SUCCESS = 0&' Registry API prototypesDeclare Function RegCloseKey Lib "advapi32.DLL" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.DLL" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.DLL" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.DLL" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.DLL" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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
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
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit numberPublic Sub savekey(hKey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(hKey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End SubPublic Function getstring(hKey As Long, strPath As String, strValue As String)Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(hKey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function
Public Sub savestring(hKey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, reglen)
'r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))r = RegCloseKey(keyhand)
End Sub
Function getdword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Longr = RegOpenKey(hKey, strPath, keyhand)' Get length/data type
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
'Else
' Call errlog("GetDWORD-" & strPath, False)
End Ifr = RegCloseKey(keyhand)
End FunctionFunction SaveDword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
'If lResult <> error_success Then Call errlog("SetDWORD", False)
r = RegCloseKey(keyhand)
End FunctionPublic Function DeleteKey(ByVal hKey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(hKey, strKey)
End FunctionPublic Function DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(hKey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function'调用
Call savestring(HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\explorer\Advanced\Folder", "a\b", 2)Call SaveDword ……写2进制健getdword 得到2进制健getstring得到字符串健
[email protected]