* 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 'Note that the following function declaration must be written in one line. 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 "Alias" 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 "Alias" 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 "Alias" 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 "Alias" 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 is the multi-string that we read 'S2 is the converted String Array 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 'Obtain the number of strings in multiple strings 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 'Add the command button and text box to the form. * EnumVal2.frm **************** 'In the commandementclick event below, we will list all names and values under 'HKEY _ LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ Run. Private Sub commandementclick () 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 'The above RegEnumValueAsAny2 call gets the length of the first Name lenName, excluding 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, "(default value)", 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
|