用VB操作註冊表(四)
夢裏水鄉
登錄數據庫Registry的Value的存取--讀取某個Key下的所有名稱的值(Value)
有時候我們需要讀取某個Key下的所有名稱的值，找到特定的或者全部名稱的值以作它用，比如我在編寫清除著名的"木馬冰河" 服務器端程序時，就需要查找HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run下的所有可疑的加載程序項目然後刪除之。
要用到的API函數RegEnumValue,其詳細描述：
VB聲明
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'以下的兩個函數是經過王國榮老師改編過的函數，與此相關，也壹並列出.並且在我們的例子程序中要用到它們。RegEnumValueAsAny可以傳入長整數和字符串；RegEnumValueAsAny2中lpData參數被改成Any後，可以使用Byte數組，由於Byte數組是采用”傳地址方式來傳遞參數的，可以省下復制字符串數據的時間，使得程序變得更加高效。
Declare Function RegEnumValueAsAny Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegEnumValueAsAny2 Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
參數說明：
hKey:Key Handle
dwIndex:欲讀取之名稱的順序
lpValueName:返回所讀取的名稱
lpcbValueName:傳入lpValueName參數的長度，返回所讀取的名稱的長度，註意這壹長度不含chr(0)
lpReserved:保留參數，實際使用時傳入ByVal 0即可
lpType:返回所讀取的數據類型
lpData:返回所讀取的數據
lpcbData:傳入lpData，返回所讀取的數據長度
返回值: =0,表示成功；≠0,表示失敗。
調用例子：
ret=0
myindex=0
while ret=0
ret=RegEnumValue(hkey,myindex,Name,ByVal 0, typeData, ByVal vbNullString, lenData)
myindex=myindex+1
wend
壹個完整的例子如下：
'*************EnumVal2.bas***************
Option Explicit
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 HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7
'註意以下的函數聲明須在壹行內寫完
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue 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 RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Declare Function RegEnumValueAsAny Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegEnumValueAsAny2 Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Sub MultiStringToStringArray(S As String, S2() As String)
'S為我們讀取出來的多重字符串
'S2為轉換後的字符串數組
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))
While pos > 0 count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
'取得多重字符串中的字符串個數
count = count - 1
ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub
'在form中添加command按鈕和text文本框
'************EnumVal2.frm****************
'以下的Command1_Click事件中我們將列舉出'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run下的所有name及其Value.
Private Sub Command1_Click()
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long Dim Name As String
Dim lenName As Long
Dim idx As Integer, j As Integer Dim bName(256) As Byte
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", hKey)
If ret <> 0 Then Exit Sub
ret = 0
idx = 0
While ret = 0
lenName = 256
ret=RegEnumValueAsAny2(hKey,idx,bName(0),lenName,ByVal 0,typeData,ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
Exit Sub
End If
'上面的RegEnumValueAsAny2調用得到了第壹個Name的長度lenName,不含chr(0)
Name = String(lenName + 1, Chr(0))
lenName = Len(Name)
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
Text1.SelText=IIf(lenName=0, "(預設值)",Left(Name,InStr(Name,Chr(0))-1)) & "=" & S & vbCrLf
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & S & vbCrLf
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & "(" & j & ") = " & SArr(j) & vbCrLf
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, L, lenData
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & L & vbCrLf
Case REG_BINARY
ReDim bArr(0 To lenData - 1) As Byte
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, bArr(0), lenData
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = "
For j = 0 To UBound(bArr)
Text1.SelText = Hex(bArr(j)) & " "
Next
Text1.SelText = vbCrLf
End Select
idx = idx + 1
Wend
RegCloseKey hKey
End Sub
用VB操作註冊表(五)
夢裏水鄉
登錄數據庫Registry的Value的存取--寫入某個Key指定名稱的值
要完成Value的寫入，需要用到API函數RegSetValueEx。下面是它的壹些說明。
VB聲明
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
參數：
hKey:Key Handle
lpValueName:Value名稱
Reserved:保留參數，具體使用時置為0即可
dwType:數據類型
lpData:所設置的數據，註意這壹參數被定義成lpData As Any，所以要傳入字符串數據時別忘了在參數前加保留字ByVal
cbData:數據的長度。註意：如果寫入的數據屬於REG_SZ、REG_EXPAND_SZ、REG_MULTI_SZ類型時，則這個長度應該包含chr(0)字符。
返回值: =0,表示成功；≠0,表示失敗。
由於RegSetValueEx的參數和RegQueryValueEx完全壹樣，他們的使用方式也差不多，因此，在這裏我只是舉出下面的例子來簡略地說壹下就行。
'下面的例子在HKEY_CURRENT_USER\Software\SetValue下建立
'Default Value-->REG_SZ "VB操作註冊表"
'str1 -->REG_SZ "我愛我的祖國"
'str2 -->REG_EXPAND_SZ "%WinDir%Command"
'str3 -->REG_MULTI_SZ "hongqt" + Chr(0) + "lstc" + Chr(0) + "edu" + Chr(0) + "cn" + Chr(0) + Chr(0)
'LongData -->REG_DWORD 99999
'BinaryData -->REG_BINARY 11,22,33,44,aa,bb,cc,dd
'*******************setvalue.bas ************************
Option Explicit
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 HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7
'註意下面的函數聲明要在壹行內寫完
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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
Sub Main()
Dim hKey As Long
RegCreateKey HKEY_CURRENT_USER, "Software\SetValue", hKey
RegSetValueEx hKey, "", 0, REG_SZ, ByVal "VB操作註冊表", 13
RegSetValueEx hKey, "Str1", 0, REG_SZ, ByVal "我愛我的祖國", 13
RegSetValueEx hKey, "Str2", 0, REG_EXPAND_SZ, ByVal "%WinDir%Command", 16
Dim S As String
S = "hongqt" + Chr(0) + "lstc" + Chr(0) + "edu" + Chr(0) + "cn" + Chr(0) + Chr(0)
RegSetValueEx hKey, "Str3", 0, REG_MULTI_SZ, ByVal S, 20
Dim L As Long
L = 99999
RegSetValueEx hKey, "LongData", 0, REG_DWORD, L, 4
Dim bArr(0 To 7) As Byte
bArr(0) = &H11: bArr(1) = &H22: bArr(2) = &H33: bArr(3) = &H44
bArr(4) = &HAA: bArr(5) = &HBB: bArr(6) = &HCC: bArr(7) = &HDD
RegSetValueEx hKey, "BinaryData", 0, REG_BINARY, bArr(0), 8
MsgBox "已完成 RegSetValueEx! 請檢查 HKEY_CURRENT_USER\Software\SetValue 的內容。"
RegCloseKey hKey
End Sub
用VB操作註冊表(六)
夢裏水鄉
登錄數據庫Registry的Value的存取--刪除某Key的Value
這個功能很容易實現。主要是要調用相應的API函數--RegDeleteValue,以下是它的壹些描述：
VB聲明
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
參數：
hKey:Key Handle
lpValueName: Value名稱，如果想刪除默認值的話，傳入""[空字符串]即可。
返回值: =0,表示成功；≠0,表示失敗。
函數調用例：
'我們假設在HKEY_CURRENT_USER\Software\SetValue有：
'預設值--VB操作註冊表
'str1--我愛我的祖國
'我們要刪除這兩個Value
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\SetValue", hKey)
If ret = 0 Then
RegDeleteValue hKey, "Str1"
MsgBox "已刪除?HKCU\Software\SetValue?SubKey?Str1?Value"
RegDeleteValue hKey, ""
MsgBox "已刪除HKCU\Software\SetValue?SubKey‘預設值’"
End If
用VB操作註冊表(七)
夢裏水鄉
登錄數據庫Registry的Key的存取
相對於註冊表中Value的存取,Key的存取要簡單得多。要用到的API函數，除了前面提到的RegOpenKey、RegCreateKey之外，主要就還有RegEnumKey、RegDeleteKey。
Key的建立，可以采用前面提到的RegCreateKey完成，此處不再舉例。
********************************************************************************