发信人: sumtyk()
整理人: fishy(2000-07-16 11:28:43), 站内信件
|
下面是我曾经编过的一段代码，适合Windows9X系统，希望对其他朋友有一些
帮助。太懒，注释不详细，如有问题，可E-Mail给我，同时欢迎指正！
E-Mail: [email protected]
Option Explicit
Public Enum DeleteType
REMOVE_NONE = 0
REMOVE_KEY = 1
REMOVE_VALUE = 2
End Enum
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegC
reateKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClas
s As String, ByVal dwOptions As Long, _
ByVal samDesired As Long, ByVal lpSecurityAttributes As Long,
phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpe
nKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDe
sired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alia
s "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, lpType
As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, lpType
As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, lpType
As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwT
ype As Long, ByVal lpValue As String, _
ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "R
egSetValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwT
ype As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenK
eyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long)
As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDel
eteKeyA" (ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegD
eleteValueA" (ByVal hKey As Long, _
ByVal lpValueName As String) As Long
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const REG_BINARY As Long = 3
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 ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
Private Function SetValueEx(ByVal hKey As Long, sValueName As String,
lType As Long, vValue As Variant, lLength As Long) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType,
sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lV
alue, 4)
Case REG_BINARY
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lV
alue, lLength)
End Select
End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName A
s String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sV
alue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = "SUMMERLOVER"
End If
' For DWORDS
Case REG_DWORD, REG_BINARY
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lVal
ue, cch)
If lrc = ERROR_NONE Then
vValue = lValue
Else
vValue = "SUMMERLOVER"
End If
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Public Sub CreateNewKey(lPredefinedKey As Long, sNewKeyName As String,
sValueName As String, vValueSetting As Variant, lValueType As Long, l
ValueLength As Long)
Dim hNewKey As Long '新键的句柄
Dim lRetVal As Long 'RegCreateKeyEx函数返回结果
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullSt
ring, REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
lRetVal = SetValueEx(hNewKey, sValueName, lValueType, vValueSettin
g, lValueLength)
RegCloseKey (hNewKey) '关闭新键句柄
End Sub
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String,
sValueName As String) As Variant
Dim lRetVal As Long 'API函数返回值
Dim hKey As Long '键的句柄
Dim vValue As Variant '存放查询结果的变量
lRetVal = RegOpenKey(lPredefinedKey, sKeyName, hKey)
If lRetVal <> ERROR_BADKEY Then
lRetVal = QueryValueEx(hKey, sValueName, vValue)
If lRetVal = 0 Then
QueryValue = vValue
Else
QueryValue = "SUMMERLOVER"
End If
RegCloseKey (hKey)
Else
QueryValue = "SUMMERLOVER"
End If
End Function
Public Sub RemoveKey(ByVal lPredefinedKey As Long, ByVal szValueName A
s String)
RegDeleteKey lPredefinedKey, szValueName
End Sub
Public Sub RemoveValue(lPredefinedKey As Long, sKeyName As String, sVa
lueName As String)
Dim lRetVal As Long 'API函数返回值
Dim hKey As Long '键的句柄
Dim vValue As Variant '存放查询结果的变量
lRetVal = RegOpenKey(lPredefinedKey, sKeyName, hKey)
If lRetVal <> ERROR_BADKEY Then
lRetVal = RegDeleteValue(hKey, sValueName)
End If
End Sub
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.99.30.132]
|
|