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))
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
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
