1. 程式人生 > >vb操作註冊表模塊

vb操作註冊表模塊

stand als result not exit load() standard got left

草率的寫了幾部分,如有不好,請諒解(QQ群:183435019)

新建一個Class,放入以下代碼

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, ByRef phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteTree Lib "advapi32.dll" Alias "RegDeleteTreeA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As Long

Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, cbName As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, ByRef lpcbValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Byte, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef 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 Long


Const REG_SZ As Long = 1
Const REG_BINARY As Long = 3
Const REG_DWORD As Long = 4
Const REG_NONE As Long = 0
Const REG_QWORD As Long = 11
Const REG_MULTI_SZ As Long = 7
Const REG_EXPAND_SZ As Long = 2
Const HKEY_LOCAL_MACHINE As Long = &H80000002

Const HKEY_CURRENT_USER As Long = &H80000001
Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Const KEY_QUERY_VALUE As Long = &H1
Const KEY_SET_VALUE As Long = &H2
Const KEY_CREATE_SUB_KEY As Long = &H4
Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Const KEY_NOTIFY As Long = &H10
Const KEY_CREATE_LINK As Long = &H20
Const SYNCHRONIZE As Long = &H100000
Const KEY_ALL_ACCESS As Long = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))


‘功能: 創建一個鍵
‘返回:TRUE成功 False 失敗

‘hKey 傳入一個已經打開的句柄
‘lpSubKey 一個要創建的名稱


Public Function CreateKey(ByVal KeyPath As String, ByVal lpSubKey As String) As Boolean
On Error GoTo l
Dim funResult As Boolean
Dim Ret As Long
Dim mkey As Long
Select Case Left(KeyPath, InStr(KeyPath, "\") - 1)
Case "HKEY_CURRENT_USER"
mkey = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
mkey = HKEY_LOCAL_MACHINE
Case Else
CreateKey = False
Exit Function

End Select

KeyPath = Mid(KeyPath, InStr(KeyPath, "\") + 1)
RegCreateKey mkey, KeyPath & "\" & lpSubKey, Ret
If Ret <> 0 Then funResult = True
CloseKey Ret

CreateKey = funResult
Exit Function
l:
CreateKey = False

End Function

‘功能: 打開一個鍵
‘返回: 鍵句柄

Public Function OpenKey(ByVal hkey As Long, ByVal lpSubKey As String) As Long
Dim funResult As Long
RegOpenKeyEx hkey, lpSubKey, 0, KEY_ALL_ACCESS, RetKey
funResult = RetKey
OpenKey = funResult
End Function


‘功能打開一個鍵,傳入,這個鍵的完整路徑

Public Function OpenKeyPath(ByVal KeyPath As String) As Long
Dim funResult As Long
Dim hkey As Long
Dim keyName As String
Dim Ret As Long

Select Case Left(KeyPath, InStr(KeyPath, "\") - 1)
Case "HKEY_CURRENT_USER"
hkey = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
hkey = HKEY_LOCAL_MACHINE

End Select

KeyPath = Mid(KeyPath, InStr(KeyPath, "\") + 1)
RegOpenKeyEx hkey, KeyPath, 0, KEY_ALL_ACCESS, funResult
OpenKeyPath = funResult


End Function

‘功能: 枚舉鍵
‘返回: PropertyBag(Count鍵表示共有多少數據),獲取值為索引號,從0開始
‘hKey: 傳入一個已經打開句柄
Public Function EnumKey(ByVal hkey As Long) As PropertyBag

Dim funResult As New PropertyBag
Dim Ret As Long
Dim keyName As String
Dim idx As Long
keyName = String(255, Chr(0))

Do While (Ret = RegEnumKey(hkey, idx, keyName, Len(keyName))) <> 0
funResult.WriteProperty CStr(idx), Left(keyName, InStr(keyName, Chr(0)))
idx = idx + 1
keyName = String(255, Chr(0))
Loop

Call funResult.WriteProperty("Count", idx)
Set EnumKey = funResult
Set funResult = Nothing

End Function

‘功能:刪除鍵,傳入一個完整的路徑
Public Function DeleteKey(ByVal KeyPath As String) As Boolean
Dim hkey As Long
Dim keyName As String
Dim Ret As Long

Select Case Left(KeyPath, InStr(KeyPath, "\") - 1)
Case "HKEY_CURRENT_USER"
hkey = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
hkey = HKEY_LOCAL_MACHINE

End Select
KeyPath = Mid(KeyPath, InStr(KeyPath, "\") + 1)

If (InStr(KeyPath, "\")) = 0 Then
Ret = RegDeleteTree(hkey, KeyPath)
If Ret = 0 Then
DeleteKey = True
End If
Exit Function
End If

keyName = Mid(KeyPath, InStrRev(KeyPath, "\") + 1)
KeyPath = Left(KeyPath, Len(KeyPath) - Len(keyName) - 1)
Ret = RegDeleteTree(OpenKey(hkey, KeyPath), keyName)
If Ret = 0 Then DeleteKey = True

End Function

‘功能: 設置REG_SZ鍵值
‘KeyPath 傳入一個完整路徑
‘lpValueName 值名稱
‘lpData 值
Public Function SetKeyValueREG_SZ(ByVal KeyPath As String, ByVal lpValueName As String, ByVal lpData As String) As Long
Dim Ret As Long
Dim hkey As Long

hkey = OpenKeyPath(KeyPath)
Ret = RegSetValueEx(hkey, lpValueName, 0, REG_SZ, ByVal lpData, LenB(lpData))
SetKeyValueREG_SZ = Ret
CloseKey hkey

End Function

‘功能: 設置REG_BINARY鍵值
‘KeyPath 傳入一個完整路徑
‘lpValueName 值名稱
‘lpData 值
Public Function SetKeyValueREG_BINARY(ByVal KeyPath As String, ByVal lpValueName As String, ByVal lpData As Long) As Long
Dim Ret As Long
Dim hkey As Long

hkey = OpenKeyPath(KeyPath)
Ret = RegSetValueEx(hkey, lpValueName, 0, REG_BINARY, ByVal lpData, 4)
SetKeyValueREG_BINARY = Ret
cloeskey hkey

End Function

‘功能: 設置REG_DWORD鍵值
‘KeyPath 傳入一個完整路徑
‘lpValueName 值名稱
‘lpData 值
Public Function SetKeyValueREG_DWORD(ByVal KeyPath As String, ByVal lpValueName As String, ByVal lpData As Long) As Long
Dim Ret As Long
Dim hkey As Long

hkey = OpenKeyPath(KeyPath)
Ret = RegSetValueEx(hkey, lpValueName, 0, REG_DWORD, lpData, 4)
SetKeyValueREG_DWORD = Ret
CloseKey hkey

End Function

‘功能: 設置REG_QWORD鍵值
‘KeyPath 傳入一個完整路徑
‘lpValueName 值名稱

‘lpData 值
Public Function SetKeyValueREG_QWORD(ByVal KeyPath As String, ByVal lpValueName As String, ByVal lpData As Long) As Long
Dim Ret As Long
Dim hkey As Long

hkey = OpenKeyPath(KeyPath)
Ret = RegSetValueEx(hkey, lpValueName, 0, REG_QWORD, lpData, 8)
SetKeyValueREG_QWORD = Ret
CloseKey hkey

End Function

‘功能: 設置REG_MULTI_SZ鍵值
‘KeyPath 傳入一個完整路徑
‘lpValueName 值名稱

‘lpData 值
Public Function SetKeyValueREG_MULTI_SZ(ByVal KeyPath As String, ByVal lpValueName As String, ByVal lpData As String) As Long
Dim Ret As Long
Dim hkey As Long

hkey = OpenKeyPath(KeyPath)
Ret = RegSetValueEx(hkey, lpValueName, 0, REG_MULTI_SZ, ByVal lpData, Len(lpData))
SetKeyValueREG_MULTI_SZ = Ret
CloseKey hkey

End Function

‘功能: 設置REG_EXPAND_SZ鍵值
‘KeyPath 傳入一個完整路徑
‘lpValueName 值名稱

‘lpData 值
Public Function SetKeyValueREG_REG_EXPAND_SZ(ByVal KeyPath As String, ByVal lpValueName As String, ByVal lpData As String) As Long
Dim Ret As Long
Dim hkey As Long

hkey = OpenKeyPath(KeyPath)
Ret = RegSetValueEx(hkey, lpValueName, 0, REG_EXPAND_SZ, ByVal lpData, Len(lpData))
SetKeyValueREG_REG_EXPAND_SZ = Ret
CloseKey hkey

End Function

Public Function DeleteValue(ByVal KeyPath As String, ByVal VlaueName As String) As Boolean
Dim funResult As Boolean
Dim Ret As Long
Dim hkey As Long
hkey = OpenKeyPath(KeyPath)

Ret = RegDeleteValue(hkey, VlaueName)
If Ret = 0 Then DeleteValue = True
CloseKey hkey


End Function


‘功能: 枚舉值
‘返回PropertyBag
‘取出 .ReadProperty(索引)
Public Function EnumValue(ByVal KeyPath As String) As PropertyBag
Dim funResult As New PropertyBag
Dim hkey As Long
Dim szBuffer As String, sValue(599) As Byte, dwIndex As Long, Ret As Long
dwIndex = 0
szBuffer = Space(255)
hkey = OpenKeyPath(KeyPath)

Do While Ret = RegEnumValue(hkey, dwIndex, szBuffer, 255, ByVal 0&, REG_SZ, sValue(0), 600) <> 0
If InStr(szBuffer, vbNullChar) > 0 Then szBuffer = Left(szBuffer, InStr(szBuffer, vbNullChar) - 1)
funResult.WriteProperty dwIndex, szBuffer
dwIndex = dwIndex + 1
szBuffer = Space(50)
Loop

funResult.WriteProperty "Count", dwIndex
Set EnumValue = funResult
CloseKey hkey

End Function
Public Function CloseKey(ByVal hkey As Long)
RegCloseKey hkey
End Function

測試代碼


Private Sub Form_Load()

Call Regedit.CreateKey("HKEY_CURRENT_USER\Software", "MyPath") ‘在HKEY_CURRENT_USER\Software下創建一個名為MyPath的鍵

Call Regedit.SetKeyValueREG_SZ("HKEY_CURRENT_USER\Software\MyPath", "Value", "Data") ‘在HKEY_CURRENT_USER\Software\MyPath新增一個名為Value的字符串,值為Data

Dim pb As New PropertyBag
Set pb = Regedit.EnumValue("HKEY_CURRENT_USER\Software\MyPath") ‘‘枚舉HKEY_CURRENT_USER\Software\MyPath下的值,
For i = 0 To pb.ReadProperty("Count") - 1
Debug.Print pb.ReadProperty(i)
Next


Regedit.DeleteKey ("HKEY_CURRENT_USER\Software\MyPath") ‘‘刪除HKEY_CURRENT_USER\Software\MyPath這個鍵

End Sub

vb操作註冊表模塊