Call APIs in VB to operate the Registry

Source: Internet
Author: User

Sometimes we need to read the values of all names under a Key and find the values of a specific or all names for use, for example, when I write a program to clear the famous "MoMA glacier" server, you need to find all suspicious loader projects under HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ Run and delete them.
For a detailed description of the API functions to be used, see "Registry programming related functions. A complete example is as follows:

* 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

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.